Ошибка обработки макросов
-
- Сообщения: 3
- Зарегистрирован: 19 апр 2016 10:30
Как прописать больше листов? Отпишитесь если кто в курсе. Если ничего не прописать - импортируется только первый лист.
parfumkashop писал(а):Как прописать больше листов? Отпишитесь если кто в курсе. Если ничего не прописать - импортируется только первый лист.
Чтобы ответить на этот вопрос нужно знать, какие настройки импорта были сделаны и увидеть содержимое прайс-листа и макроса.
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
-
- Сообщения: 3
- Зарегистрирован: 19 апр 2016 10:30
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
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
Вам нужно обратиться к разработчику макроса.
Пишу макросы VBA на заказ от 100 руб. обращаться в личку.
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
Подключение макросов | Подключение макросов 2 | Регулярные выражения | Руководство E-Trade PLI | EdiTTempDir | РРЦ | правильное обновление ПЛИ и СС | данные импортируются как звездочки | контакты тех.поддержки
-
- Сообщения: 3
- Зарегистрирован: 19 апр 2016 10:30
) Elbuz Group - они меня на форум отправили
Можем доработать для вас макрос. Стоимость 20 USD.
Так же у Вас есть возможность обратится для доработки к сторонним разработчиком макросов VBA.
Так же у Вас есть возможность обратится для доработки к сторонним разработчиком макросов VBA.
C уважением, поддержка ElbuzGroup.
Документация E-Trade Jumper
Документация E-Trade Jumper