'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