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

Помощь пользователям в работе с программой E-Trade PriceList Importer
parfumkashop
Сообщения: 3
Зарегистрирован: 19 апр 2016 10:30

19 апр 2016 10:33

Как прописать больше листов? Отпишитесь если кто в курсе. Если ничего не прописать - импортируется только первый лист.
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

19 апр 2016 10:59

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

Чтобы ответить на этот вопрос нужно знать, какие настройки импорта были сделаны и увидеть содержимое прайс-листа и макроса.
parfumkashop
Сообщения: 3
Зарегистрирован: 19 апр 2016 10:30

19 апр 2016 11:14

http://floomby.ru/s2/3g2wnE
http://floomby.ru/s2/Xg2wnd
Option Explicit

Public Sub MainVBA()
' (С) 2012 ElbuzGroup, for E-Trade PriceList Importer
Dim lngSheetID As Long ' номер листа с которым работать
Dim lngRowSourceCur As Long
Dim lngColumnSource As Long
Dim lngTotalColumns As Long
Dim varNewFileName As Variant
Dim fs As Variant

lngColumnSource=2 ' номер стобца с которым работать
lngTotalColumns=WorkSheets.Count


' Корректируем
For lngSheetID=1 TO lngTotalColumns
Worksheets(lngSheetID).Activate
For lngRowSourceCur = 1 To ActiveSheet.UsedRange.Rows.Count
If ActiveSheet.Cells(lngRowSourceCur, lngColumnSource).Formula <> "" Then
ActiveSheet.Cells(lngRowSourceCur, lngColumnSource).Formula = "'" & ActiveSheet.Cells(lngRowSourceCur, lngColumnSource).Formula
End If
Next lngRowSourceCur
Next lngSheetID
Worksheets(1).Activate

' Сохраняем данные в новом файле из буфера обмена
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 1
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).SaveAs varNewFileName, Workbooks.Item(nSourceFile).FileFormat, , , False, False, 1, 2
Workbooks.Item(nDestFile).Close
'Application.Quit
End Sub
Ixenon
Сообщения: 743
Зарегистрирован: 19 ноя 2011 09:03

19 апр 2016 12:24

Вам нужно обратиться к разработчику макроса.
parfumkashop
Сообщения: 3
Зарегистрирован: 19 апр 2016 10:30

19 апр 2016 12:44

:)) Elbuz Group - они меня на форум отправили
Аватара пользователя
support
Сообщения: 10553
Зарегистрирован: 09 ноя 2008 21:37

19 апр 2016 18:01

Можем доработать для вас макрос. Стоимость 20 USD.
Так же у Вас есть возможность обратится для доработки к сторонним разработчиком макросов VBA.
C уважением, поддержка ElbuzGroup.
Документация E-Trade Jumper
Ответить

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