Ошибка обработки макросов

Помощь пользователям в работе с программой E-Trade PriceList Importer
krasenkov
Сообщения: 363
Зарегистрирован: 03 май 2011 20:41

07 фев 2014 14:40

Здравствуйте, подскажите можно как-то вылечить эту ошибку?
Настройка макросов VBA - Проверить макрос на прайс-листе
Выдает ошибку, см. скриншот.
Ну и понятное дело, эта ошибка стопорит импорт при импорте всех прайсов.
В настройках офиса макросы разрешены. Раньше все работало, а сейчас не понятно что произошло.
На новой базе ошибка не уходит, переустановка PLI с поднятием бекапа БД не помогает.
Макрос и прайс прилагается
Вложения
price.rar
(109.51 КБ) 227 скачиваний
macros.rar
(538 байт) 212 скачиваний
Screenshot_3.png
Screenshot_3.png (69.95 КБ) 4955 просмотров
Аватара пользователя
support
Сообщения: 10553
Зарегистрирован: 09 ноя 2008 21:37

10 фев 2014 10:42

Вероятнее всего ошибка в макросе. Обратитесь к разработчику макроса.
C уважением, поддержка ElbuzGroup.
Документация E-Trade Jumper
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

11 фев 2014 08:06

Привет, попробуй этот.
Вложения
macros.rar
(989 байт) 212 скачиваний
krasenkov
Сообщения: 363
Зарегистрирован: 03 май 2011 20:41

11 фев 2014 16:53

Ixenon писал(а):Привет, попробуй этот.

Что-то не хотит
Вложения
Screenshot_5.png
Screenshot_5.png (72.95 КБ) 4945 просмотров
Screenshot_4.png
Screenshot_4.png (84.02 КБ) 4945 просмотров
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

11 фев 2014 18:25

Первый блин получился комом :-)
Вот исправленный вариант.

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

Option Explicit

Public Sub MainVBA()
Dim lngSheetID          As Long ' номер листа с которым работать
Dim varNewFileName      As Variant
Dim fs                  As Variant
Dim i As Long
Dim j As Long
Dim RowsCount As Long
Dim ColumnsCount As Long
Dim PriceColumn As Long
Dim Brand As String
Dim Category As String
Dim FileNameInFull As String
Dim FileNameInDataModifySplit As Variant
Dim FileNameInDataModify As String

Application.ScreenUpdating = False

'Корректируем
For i = 1 To ActiveSheet.UsedRange.Rows.Count
   If Cells(i, 1) <> "" And Trim(Cells(i, 2)) = "" Then
      Category = Cells(i, 1)
   Else
      Cells(i, 5) = Category
      If Cells(i, 1) <> "" And Trim(Cells(i, 2)) <> "" And Cells(i, 1).Interior.ColorIndex = 35 Then
         Brand = Cells(i, 1)
         Cells(i, 6) = Brand
         Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
      Else
         Cells(i, 6) = Brand
         Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
      End If
   End If
Next i

'Сохраняем данные в новом файле из буфера обмена
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).Paste
   Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).Name = Workbooks.Item(nSourceFile).Sheets.Item(lngSheetID).Name
Next lngSheetID
Workbooks.Item(nDestFile).Sheets.Item(1).Activate
Workbooks.Item(nSourceFile).Sheets.Item(1).Activate

Application.ScreenUpdating = True

Workbooks.Item(nDestFile).SaveAs varNewFileName, Workbooks.Item(nSourceFile).FileFormat, , , False, False, 1, 2
Workbooks.Item(nDestFile).Close
'Application.Quit
End Sub
krasenkov
Сообщения: 363
Зарегистрирован: 03 май 2011 20:41

11 фев 2014 19:10

Все равно что-то ругается
Вложения
Screenshot_9.png
Screenshot_9.png (93.14 КБ) 4945 просмотров
Screenshot_8.png
Screenshot_8.png (18.29 КБ) 4945 просмотров
Screenshot_7.png
Screenshot_7.png (69.42 КБ) 4945 просмотров
Screenshot_6.png
Screenshot_6.png (5.13 КБ) 4945 просмотров
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

12 фев 2014 05:40

Попробуйте этот:

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

Option Explicit

Public Sub MainVBA()
Dim lngSheetID          As Long ' номер листа с которым работать
Dim varNewFileName      As String
Dim fs                  As Variant
Dim i As Long
Dim Brand As String
Dim Category As String

Application.ScreenUpdating = False

'Корректируем
On Error Resume Next
For i = 1 To ActiveSheet.UsedRange.Rows.Count
    If Cells(i, 1) <> "" And Trim(Cells(i, 2)) = "" Then
        Category = Cells(i, 1)
    Else
        Cells(i, 5) = Category
        If Cells(i, 1) <> "" And Trim(Cells(i, 2)) <> "" And Cells(i, 1).Interior.ColorIndex = 35 Then
            Brand = Cells(i, 1)
            Cells(i, 6) = Brand
            Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
        Else
            Cells(i, 6) = Brand
            Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
        End If
    End If
Next i

'Сохраняем данные в новом файле из буфера обмена
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).Paste
    Workbooks.Item(nDestFile).Sheets.Item(lngSheetID).Name = Workbooks.Item(nSourceFile).Sheets.Item(lngSheetID).Name
Next lngSheetID
Workbooks.Item(nDestFile).Sheets.Item(1).Activate
Workbooks.Item(nSourceFile).Sheets.Item(1).Activate

Application.ScreenUpdating = True

Workbooks.Item(nDestFile).SaveAs varNewFileName, Workbooks.Item(nSourceFile).FileFormat, , , False, False, 1, 2
Workbooks.Item(nDestFile).Close
'Application.Quit
End Sub
krasenkov
Сообщения: 363
Зарегистрирован: 03 май 2011 20:41

13 фев 2014 17:10

Работает, большое спасибо.
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

13 фев 2014 17:47

krasenkov писал(а):Работает, большое спасибо.
Пожалуста :-)
Sancho.smadshop
Сообщения: 253
Зарегистрирован: 27 сен 2013 10:25

23 фев 2016 19:12

Dim lngSheetID As Long ' номер листа с которым работать

Как прописать больше листов? Отпишитесь если кто в курсе. Если ничего не прописать - импортируется только первый лист.
Ответить

Вернуться в «Техническая поддержка программы E-Trade PriceList Importer»