Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hi i have on qv application
3 multiboxes :region,country,city and one pivot table see the attached qv app
i want to export 3 multiboxes and 1 pivot table to exce by using macro
for example if i selcet region America
now i want to display on region name,country name ,city name on first 3 rows and after that i want to show pivot table below
please see attached excel files one is qlivkiew output and another on desired out put(this output i want )
i wrote some macro that not giving the exact output
please help on that
SUB TEExport
confirmation = MSGBOX ("TopSpenders Excel export has been initiated." & vbCrLf & "Do you wish to continue?"& vbCrLf &"", 36, "Export Confirmation")
IF confirmation = 7 THEN
EXIT SUB
END IF
DIM xlApp
DIM xlBook
DIM xlSheet
DIM strSheetName
DIM var
DIM fname
SET f = ActiveDocument.Variables("vfname")
fname = f.GetContent.STRING
SET v = ActiveDocument.Variables("vMacroChartId")
var = v.GetContent.STRING
SET xlApp = CREATEOBJECT("Excel.Application")
xlApp.Visible = TRUE
SET xlBook = xlApp.Workbooks.Add
SET xlSheet = xlBook.Worksheets("Sheet1")
ActiveDocument.Fields(fname).Clear
SET Doc = ActiveDocument
SET Field = Doc.Fields(fname).GetPossibleValues
FOR i=0 to Field.Count-1
Doc.Fields(fname).Clear
Doc.FIelds(fname).SELECT Field.Item(i).Text
Doc.GetApplication.WaitForIdle
Doc.GetSheetObject(var).CopyTableToClipBoard TRUE
xlApp.ActiveSheet.Paste
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Cells.EntireRow.AutoFit
strSheetName = Field.Item(i).Text
xlApp.ActiveSheet.Name = strSheetName
IF(i<Field.Count-1)THEN
IF(i>=2)THEN
xlApp.ActiveWorkbook.Worksheets.Add
END IF
IF(i<2) THEN
xlApp.Worksheets(xlApp.ActiveSheet.Index +1).SELECT
END IF
END IF
NEXT
Doc.Fields(fname).Clear
MSGBOX "TopSpenders Excel export is complete!",64,"Task Completion Notification"
END SUB
Take a look at the the following macro. I have two ways, either copying the actual image to excel, or just copying the values (one is commented out):
SUB TEExport
confirmation = MSGBOX ("TopSpenders Excel export has been initiated." & vbCrLf & "Do you wish to continue?"& vbCrLf &"", 36, "Export Confirmation")
IF confirmation = 7 THEN
EXIT SUB
END IF
DIM xlApp
DIM xlBook
DIM xlSheet
DIM strSheetName
DIM var
DIM fname
SET f = ActiveDocument.Variables("vfname")
fname = f.GetContent.STRING
SET v = ActiveDocument.Variables("vMacroChartId")
var = v.GetContent.STRING
SET xlApp = CREATEOBJECT("Excel.Application")
xlApp.Visible = TRUE
SET xlBook = xlApp.Workbooks.Add
SET xlSheet = xlBook.Worksheets("Sheet1")
ActiveDocument.Fields(fname).Clear
SET Doc = ActiveDocument
SET Field = Doc.Fields(fname).GetPossibleValues
FOR i=0 to Field.Count-1
Doc.Fields(fname).Clear
Doc.FIelds(fname).SELECT Field.Item(i).Text
Doc.GetApplication.WaitForIdle
ActiveDocument.GetSheetObject("MB01").CopyBitmapToClipBoard
xlApp.ActiveSheet.Range("B1").Select
xlApp.ActiveSheet.Paste
ActiveDocument.GetSheetObject("MB02").CopyBitmapToClipBoard
xlApp.ActiveSheet.Range("B3").Select
xlApp.ActiveSheet.Paste
ActiveDocument.GetSheetObject("MB03").CopyBitmapToClipBoard
xlApp.ActiveSheet.Range("B5").Select
xlApp.ActiveSheet.Paste
' Box1Field = ActiveDocument.GetSheetObject("MB01").GetField(0).GetProperties.Name
' Box1Value = ActiveDocument.GetSheetObject("MB01").GetField(0).GetPossibleValues.Item(0).Text
' Box2Field = ActiveDocument.GetSheetObject("MB02").GetField(0).GetProperties.Name
' Box2Value = ActiveDocument.GetSheetObject("MB02").GetField(0).GetPossibleValues.Item(0).Text
' Box3Field = ActiveDocument.GetSheetObject("MB03").GetField(0).GetProperties.Name
' Box3Value = ActiveDocument.GetSheetObject("MB03").GetField(0).GetPossibleValues.Item(0).Text
'
' xlApp.ActiveSheet.Cells(2,2).Value = Box1Field
' xlApp.ActiveSheet.Cells(2,3).Value = Box1Value
' xlApp.ActiveSheet.Cells(3,2).Value = Box2Field
' xlApp.ActiveSheet.Cells(3,3).Value = Box2Value
' xlApp.ActiveSheet.Cells(4,2).Value = Box3Field
' xlApp.ActiveSheet.Cells(4,3).Value = Box3Value
Doc.GetSheetObject(var).CopyTableToClipBoard TRUE
xlApp.ActiveSheet.Range("A8").Select
xlApp.ActiveSheet.Paste
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Cells.EntireRow.AutoFit
strSheetName = Field.Item(i).Text
xlApp.ActiveSheet.Name = strSheetName
IF(i<Field.Count-1)THEN
IF(i>=2)THEN
xlApp.ActiveWorkbook.Worksheets.Add
END IF
IF(i<2) THEN
xlApp.Worksheets(xlApp.ActiveSheet.Index +1).SELECT
END IF
END IF
NEXT
Doc.Fields(fname).Clear
MSGBOX "TopSpenders Excel export is complete!",64,"Task Completion Notification"
END SUB
Hope this helps!
Hi ,Thanks for replying .
the above script working perfectly.
but here iam generating multiple excel sheets in single excel file
what my problem is only the sheet1 has exact format like autofit row hegiht ,column
but iam not getting same format for remaining sheets . please look into above script
if any thing missing.
please help on that that would great
thanks
Change in your code:
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Cells.EntireRow.AutoFit
to:
xlApp.ActiveSheet.Cells.EntireColumn.AutoFit
xlApp.ActiveSheet.Cells.EntireRow.AutoFit
Hope this helps!
Thanks for replying
but no luck