Здравствуйте, подскажите можно как-то вылечить эту ошибку?
Настройка макросов VBA - Проверить макрос на прайс-листе
Выдает ошибку, см. скриншот.
Ну и понятное дело, эта ошибка стопорит импорт при импорте всех прайсов.
В настройках офиса макросы разрешены. Раньше все работало, а сейчас не понятно что произошло.
На новой базе ошибка не уходит, переустановка PLI с поднятием бекапа БД не помогает.
Макрос и прайс прилагается
Ошибка обработки макросов
- Вложения
-
- price.rar
- (109.51 КБ) 227 скачиваний
-
- macros.rar
- (538 байт) 212 скачиваний
-
- Screenshot_3.png (69.95 КБ) 4955 просмотров
Вероятнее всего ошибка в макросе. Обратитесь к разработчику макроса.
C уважением, поддержка ElbuzGroup.
Документация E-Trade Jumper
Документация E-Trade Jumper
Привет, попробуй этот.
- Вложения
-
- macros.rar
- (989 байт) 212 скачиваний
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Ixenon писал(а):Привет, попробуй этот.
Что-то не хотит
- Вложения
-
- Screenshot_5.png (72.95 КБ) 4945 просмотров
-
- Screenshot_4.png (84.02 КБ) 4945 просмотров
Первый блин получился комом
Вот исправленный вариант.
Вот исправленный вариант.
Код: Выделить всё
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
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Все равно что-то ругается
- Вложения
-
- Screenshot_9.png (93.14 КБ) 4945 просмотров
-
- Screenshot_8.png (18.29 КБ) 4945 просмотров
-
- Screenshot_7.png (69.42 КБ) 4945 просмотров
-
- Screenshot_6.png (5.13 КБ) 4945 просмотров
Попробуйте этот:
Код: Выделить всё
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
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Работает, большое спасибо.
Пожалустаkrasenkov писал(а):Работает, большое спасибо.
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
-
- Сообщения: 253
- Зарегистрирован: 27 сен 2013 10:25
Dim lngSheetID As Long ' номер листа с которым работать
Как прописать больше листов? Отпишитесь если кто в курсе. Если ничего не прописать - импортируется только первый лист.