Мультивалюта, не работает?

[batr]

Доброго времени суток!

Помогите с решением проблемы. В прайсе поставщика есть 3 различных вида цены:
1) Доллары - числовой формат ячейки
2) Рубли (0р. - форматированием ячейки)
3) Доллары-2 ($0 - форматированием ячейки)

Как я только не пробовал. И как в инструкции (даже базу отдельно создал), и просто - установив валюту прайса USD отлавливал "р." и "$"... но ничего не помогает. Какая валюта прайса установлена - такая и устанавливается.
В инструкции есть странный способ обпределения форматирования ячейки (хотя в excel это легко посмотреть), но он показывает RUB (т.е. валюту прайс листа), а не как в инструкции.


Картинка полностью:
http://multeam.ru/etht/pli_error_price.jpg

P.S. и еще есть маленькая проблема, - после пакетной обработки - цена остается старая и не выгружается в СТУС из СТИПП, но вижу по этой проблеме уже народ отписался. Работа встала из за этих двух ошибок (вторая не часто, но доверия нет, что программа выгрузит все правильно). Я мучаюсь с первой тысячей товаров, а впереди порядка 40 тысяч. Проверять вручную анрил.

Заранее спасибо за помощь.

[batr]

Попробовал разрулиться с VBS, написал маленький скрипт, в надежде на то, что установив валюту прайс листа в "USD", и добавив поиск "RUB" в колонке с ценой - оно сработает правильно.

Но пишет что не найден такой же файл с подчеркиванием. Доверие установил, но не работает - пишет про MainVBA, и про отключенные скрипты, но я все разрешил - как в инструкции

Код: Выделить всё

Option Explicit

Public Sub MainVBA()

  Dim lngI As Long
  Dim CurPrice As String
   Sheets("Base_price").Select
   For lngI = 1 To Cells(Rows.Count, 6).End(xlUp).Row
       CurPrice = Cells(lngI, 6).Text
       If Cells(lngI, 6).NumberFormat = "#,##0$" And Len(CurPrice) > 0 Then
           Cells(lngI, 6).NumberFormat = "@"
	   CurPrice = Replace(CurPrice, "р.", "")
           Cells(lngI, 6).Interior.Color = vbYellow
           Cells(lngI, 6).Value = CurPrice + "RUB"
       End If
   Next lngI

End Sub

[Ixenon]

Вам в скрипте вашем, в конце нужно произвести сохранение результата в новый файл.
Имя сохраняемого файла = "_" + "старое_имя_файла".

И еще, попробуйте пробежаться циклом и при этом в зависимости от форматирования исходной ячейки с ценой, в отдельном столбце проставить значения.
Если форматирование цены для евро, то значение будет "EUR"
если форматирование цены для доллара, то значение будет "USD"
если форматирование цены для рублей, то значение будет "RUB"
Таким образом у Вас в прайсе появится еще один столбец в котором будет указана валюта цены.
После этого в настройках прайса нужно указать адрес этого столбца в блоке "Адреса столбцов" для столбца "Валюта"
В настройке мультивалюты, для каждой валюты в поле что искать, нужно прописать эти значения для евро - EUR, для долларов - USD, для рублей - RUB

Пример макроса есть, например в этой теме http://forum.elbuz.com/viewtopic.php?f=15&t=1165&p=6183 возможно это Вам окажется полезным.

[support]

Вышлите пожалуйста необходимую информацию нам на электронную почту

Код: Выделить всё

e-special@elbuz.com

для проверки на нашей стороне.
От вас потребуется ВСЕ ниже перечисленные пункты:
Архив Базы Данных программы.
Импортируемый прайс-лист поставщика.
Наименование поставщика, к которому относится импортируемый прайс-лист.
Наименование категории.
Наименование товара на котором можно проверить проблему.
Описание проблемы, с которой Вы столкнулись.

[batr]

e-special, хорошо, подготовлю и вышлю.

Пока получилось решить проблему скриптом:

Код: Выделить всё

Option Explicit

Public Sub MainVBA()

  Dim lngI As Long
  Dim CurPrice As String
  Dim CurFormat As String
    Dim varNewFileName As Variant
    Dim fs As Variant
    Dim lngSheetID      As Long
    Dim lngRowSourceCur As Long
    Dim lngColumnSource As Long
  
   Sheets("Base_price").Select
   For lngI = 1 To ActiveSheet.UsedRange.Rows.Count
   'For lngI = 1 To Cells(Rows.Count, 6).End(xlUp).Row
       CurPrice = Cells(lngI, 6).Text
       CurFormat = Cells(lngI, 6).NumberFormat
       Cells(lngI, 9).Value = CurFormat
       ' RUB - #,##0.00$
       ' USD - #,##0
       ' USD - 0
       ' USD - [$$-409]#,##0.00
       ' USD - General
       ' USD - _-[$$-409]* #,##0.00_ ;_-[$$-409]* -#,##0.00 ;_-[$$-409]* "-"??_ ;_-@_
       
       If ((CurFormat = "#,##0$") Or (CurFormat = "#,##0.00$")) And Len(CurPrice) > 0 Then
           Cells(lngI, 10).Interior.Color = vbYellow
           Cells(lngI, 10).Value = "RUB"
       End If
       If ((CurFormat = "#,##0") Or (CurFormat = "0") Or (CurFormat = "[$$-409]#,##0.00") Or (CurFormat = "General")) And Len(CurPrice) > 0 Then
           Cells(lngI, 10).Interior.Color = vbRed
           Cells(lngI, 10).Value = "USD"
       End If
       
   Next lngI

Set fs = CreateObject("Scripting.FileSystemObject")
    varNewFileName = Replace(ActiveWorkbook.FullName, ActiveWorkbook.Name, "") & "_" & ActiveWorkbook.Name
    If fs.FileExists(varNewFileName) = True Then
        Kill varNewFileName
    End If
    
    Application.CutCopyMode = False
    Application.DisplayAlerts = False

    Dim nSourceFile As Long
    Dim nDestFile As Long
    Dim nTotalSheets As Long
    Dim nSheetsAdd As Long

    nSourceFile = Workbooks.Count
    nTotalSheets = Workbooks.Item(nSourceFile).Worksheets.Count
    Workbooks.Add
    nDestFile = Workbooks.Count

    If nTotalSheets > 3 Then
        For nSheetsAdd = 1 To nTotalSheets - 3
            Workbooks.Item(nDestFile).Sheets.Add
        Next nSheetsAdd
    End If
    
    For lngSheetID = 1 To nTotalSheets
        Workbooks.Item(nSourceFile).Sheets.Item(lngSheetID).Activate
        Workbooks.Item(nSourceFile).Sheets.Item(lngSheetID).UsedRange.Copy
        Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).Activate
        Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).Range("A1").Select
        Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).PasteSpecial
        Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).Name = Workbooks.Item(nSourceFile).Sheets.Item(lngSheetID).Name
    Next lngSheetID
    Workbooks.Item(nSourceFile).Sheets.Item(1).Activate
    ' FileFormat = xlTemplate8 = 17
    Workbooks.Item(nDestFile).SaveAs varNewFileName, 17, , , False, False, 1, 2
    Workbooks.Item(nDestFile).Close


End Sub

Но проблема осталась, при прописывании и проверке VBA скрипта, пишет "Не найден файл - c:\Users\User\Documents\Прайсы\OCS\HP_D\_HP_121220D.xls", а если просто открыть файл без подчеркивания, вставить скрипт - все работает, файл создается. Куда копать?