VPF::Макрос.Экспорт в различные эксель файлы

KevLev

Дата 20.4.2016, 09:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 19.4.2016

Репутация: нет
Всего: нет

Всем привет!Есть макрос загрузки в эксель:

Код


'Variable to hold default root folder name
Dim strRootFolder
strRootFolder = "X:\МАКРОСЫ\"

Dim reportName 
reportName="Product"

Dim WidgetID 
WidgetID = "ProductB"

Dim widgetProductA
widgetProductA = "A"

Dim widgetProductB 
widgetProductB = "B"

Dim widgetProductC 
widgetProductC = "C"

Function ExportProduct()

CALL CheckFolderExists(strRootFolder)    

ActiveDocument.ClearAll true

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = true    
Set xlDoc = xlApp.Workbooks.Add 'open new workbook
nSheetsCount = 0
CALL RemoveDefaultSheet(xlDoc)    

nSheetsCount = xlDoc.Sheets.Count 
xlDoc.Sheets(nSheetsCount).Select
Set xlSheet = xlDoc.Sheets(nSheetsCount)    

CALL ExportRevenueWidgets(xlDoc,xlSheet)    

'Save generated report
xlApp.ActiveWorkBook.SaveAs strRootFolder &" "&reportName & ".xlsx" 
xlApp.Quit    

End Function

'Call Export Widgets By Sheet
Function ExportRevenueWidgets(xlDoc,xlSheet)
ActiveDocument.GetField("ProductNam e").select widgetProductA
CALL ExportWidget(xlDoc,xlSheet,WidgetID , widgetProductA)
ActiveDocument.GetField("ProductNam e").Clear    
ActiveDocument.GetField("ProductNam e").select widgetProductB
CALL ExportWidget(xlDoc,xlSheet,WidgetID , widgetProductB)
ActiveDocument.GetField("ProductNam e").Clear
ActiveDocument.GetField("ProductNam e").select widgetProductC
CALL ExportWidget(xlDoc,xlSheet,WidgetID , widgetProductC)
ActiveDocument.GetField("ProductNam e").Clear
End Function

'Export Widgets by Type
Function ExportWidget(xlDoc,xlSheet,widget, Value)    
Select Case Value
Case widgetProductA:    
Call Export(0,xlSheet,widget,xlDoc,widge tProductA)    
Case widgetProductB:    
Call Export(1,xlSheet,widget,xlDoc,widge tProductB)
Case widgetProductC:    
Call Export(1,xlSheet,widget,xlDoc,widge tProductC)
End Select
End Function

'Export Widgets
Function Export(IsNeedNewSheet,xlSheet,widge tID,xlDoc,sheetName)    

If IsNeedNewSheet = 1 then
CALL AddExcelSheet(xlDoc,sheetName)
nSheetsCount = xlDoc.Sheets.Count
xlDoc.Sheets(nSheetsCount).Select
Set xlSheet = xlDoc.Sheets(nSheetsCount)
Else
xlSheet.Name = sheetName
End If    

nRow = xlSheet.UsedRange.Rows.Count

If nRow > 1 Then
nRow = nRow + 4
Else
nRow = nRow + 2
End If

Set SheetObj = ActiveDocument.GetSheetObject(widge tID)    

ObjCaption = SheetObj.GetCaption.Name.v
xlSheet.Range("A"&nRow-1) = ObjCaption
xlSheet.Range("A"&nRow-1).Font.Bold = true

'Copy the chart object to clipboard
SheetObj.CopyTableToClipboard true

'Paste the chart object in Excel file
xlSheet.Paste xlSheet.Range("A"&nRow) 

'Format the excel file    
xlSheet.cells.Font.Size = "8"
xlSheet.cells.Font.Name = "Tahoma"    

End Function

'Add New Sheet in Excel File
Sub AddExcelSheet(xlDoc, strSheetName)

xlDoc.Sheets.Add, xlDoc.Sheets(xlDoc.Sheets.Count)
Set xlSheet = xlDoc.Sheets(xlDoc.Sheets.Count)
xlSheet.Name = Left(strSheetName, 31)
End Sub

'Remove Default Sheets from Excel Files
Sub RemoveDefaultSheet(xlDoc)
Do
nSheetsCount = xlDoc.Sheets.Count
If nSheetsCount = 1 then
Exit Do
Else
xlDoc.Sheets(nSheetsCount).Select
xlDoc.ActiveSheet.Delete
End If
Loop
End Sub


'Checks whether given folder exists if not creates the given folder
Function CheckFolderExists(path)    

Set fileSystemObject = CreateObject("Scripting.FileSystemO bject") 

If Not fileSystemObject.FolderExists(path) Then
fileSystemObject.CreateFolder(path) 
End If

End Function

Проблема в том,что,таблицу,которую макрос экспортирует в эксель,он ее разбивает по строкам.И каждой строке таблицы соответствует свой отдельный лист.
Задача: чтобы макрос разбивал ТАКЖЕ по строчно,но КАЖДАЯ строка экспортировалась в ОТДЕЛЬНЫЙ эксель файл.
Могу предположить,что проблема в функции Function ExportProduct(),но не уверен,т.к. в макросах очень слабоват.

Это сообщение отредактировал(а) KevLev - 20.4.2016, 15:52

Akina

Дата 20.4.2016, 10:13 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20570
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 25
Всего: 453

1) Пользуйтесь тегом "Код" - "Visual Basic".
2) Приложите к сообщению необходимый минимальный набор файлов для воспроизведения среды исполнения.

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

KevLev

Дата 20.4.2016, 10:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 19.4.2016

Репутация: нет
Всего: нет

Подскажите пожалуйста,а каким образом использовать этот код в макросе?Куда нужно его записать?

Akina

Дата 20.4.2016, 10:43 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20570
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 25
Всего: 453

Цитата(KevLev @ 20.4.2016, 11:35

)

каким образом использовать этот код в макросе?

Тег "Код" используют при оформлении сообщения в конференции. Чтобы другие участники видели вменяемый код, а не текстовую "лапшу".

--------------------

Duddha

Дата 25.4.2016, 12:40 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 0
Регистрация: 13.12.2011

Репутация: нет
Всего: нет

Если не сильно ломать существующий код, то можно изменить AddExcelSheet - добавить туда создание нового Workbook-а. Предварительно, конечно, надо сохранить предыдущую открытую книгу, или в конце скопом сохранить все сгенерированные файлы.
Чтобы не приходилось потом из созданной книги удалять лишние листы (это у вас делается при помощи CALL RemoveDefaultSheet(xlDoc)), попробуйте такой вариант создания новой книги - xlApp.Workbooks.Add(xlWBATWorksheet).

Этот ответ добавлен с нового Винграда - http://vingrad.com

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »