Макрос загрузки в различные эксель файлы из Qlikview

Автор Максим, 20 апреля 2016, 04:00:32

« назад - далее »

Максим

Всем привет!Возможно кто то из вас сталкивался с макросами в КликВью и сможет помочь :)Есть макрос загрузки в эксель:

'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("ProductName").select widgetProductA
CALL ExportWidget(xlDoc,xlSheet,WidgetID, widgetProductA)
ActiveDocument.GetField("ProductName").Clear
ActiveDocument.GetField("ProductName").select widgetProductB
CALL ExportWidget(xlDoc,xlSheet,WidgetID, widgetProductB)
ActiveDocument.GetField("ProductName").Clear
ActiveDocument.GetField("ProductName").select widgetProductC
CALL ExportWidget(xlDoc,xlSheet,WidgetID, widgetProductC)
ActiveDocument.GetField("ProductName").Clear
End Function

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

'Export Widgets
Function Export(IsNeedNewSheet,xlSheet,widgetID,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(widgetID)

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.FileSystemObject")

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

End Function


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

Яндекс.Метрика