Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Dear All,
can anyone please help writing a macro that would enable exporting a graphic chart to excel (in a graphic structure) or instruct how to do it without one?
Thank you.
BR,
Przemek
Here's a simple example on how to achieve this. First I create an Excel object and add a workbook. Then I copy my chart to the clipboard. Finally I paste it in. Done
sub ExportBitmapExcel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard
objExcel.ActiveSheet.Paste
end sub
Even I am looking for this one..
Here's a simple example on how to achieve this. First I create an Excel object and add a workbook. Then I copy my chart to the clipboard. Finally I paste it in. Done
sub ExportBitmapExcel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard
objExcel.ActiveSheet.Paste
end sub
Thanks a lot for the code.
There's, however, a problem I can't cope with - macro stops because ActiveX component can't create object: "Excel. Application' . Do you know what should I change?
BR,
Przemek
Try this code, gives you some extra help and functionality. Just exchange the objects to your own, CS06 to xxxx for instance. You can get the object names by right clicking and check properties or look at the Sheets tab under Document properties for an overview.
About the activeX problem you are having you need to go in to the macro editor and change to "allow system access" on both requested module security and current local security.
SUB ReportStepThroughValuesExcel
'--------------------
'Loop through values and chose 1 each time
fieldName=trim(inputbox("Type field name to loop over (CompanyUnit or Region). (Case sensitive)","Loop through values","CompanyUnit"))
If fieldName="" then
Exit sub
End if
Set val=ActiveDocument.Fields(fieldName).GetPossibleValues(20000)
'Set val=activedocument.Fields(fieldName).GetSelectedValues(20000)
For i=0 to val.Count-1
ActiveDocument.Fields(fieldName).Select val.Item(i).Text
returnval=6
'msgbox(val.Item(i).Text&chr(13) & i+1 & " of " &val.Count & chr(13 )& chr(13)& "Qlik:" & chr(13) & " YES: To Create A Report" & chr(13) & " NO: To skip to next value" & chr(13) & " CANCEL: To cancel", 259, "Step Through Values")
if returnval=2 then
Exit For
ElseIf returnval=6 then
'bmarkName=inputbox("Enter a Bookmark Name", "User Entry", "BookMark " & i+1 & ", " & fieldName & "=" & val.Item(i).Text)
'ActiveDocument.CreateDocBookmark false, bmarkName
set XLApp = CreateObject("Excel.Application")
XLApp.Visible = True
set XLDoc = XLApp.Workbooks.Add
'&[File]&[Date]
'strFileName = "C:\Temp\"&[Date] & Year(now())& "-" & Month(now())& "-" & Day(now()) & ".xls"
'Declare
'strFileName = "C:\Temp\RR_"& Year(now())&"-"&Month(now())&"_Enhet_"&val.Item(i).Text&".xls"
strFileName = "RR_"& Year(now())&"-"&Month(now())&"_Enhet_"&val.Item(i).Text&".xls"', fileformat:=56
'oXL.saveas "c:\MyExcel.xls", fileformat:=56
',FileFormat:=xlNormal"
'CompanyLogo
ActiveDocument.GetSheetObject("TX05").CopyBitmapToClipboard
XLApp.Worksheets(1).Range("A1").Select()
XLApp.Worksheets(1).PasteSpecial
'ReportName
ActiveDocument.GetSheetObject("TX07").CopyTextToClipboard
XLApp.Worksheets(1).Range("J8").Select()
XLApp.Worksheets(1).PasteSpecial
'XLApp.Worksheets(1).cells.mergecells = false
'Graph1
ActiveDocument.GetSheetObject("CS06").CopyTextToClipboard
XLApp.Worksheets(1).Range("A9").Select()
XLApp.Worksheets(1).PasteSpecial
'Table1
ActiveDocument.GetSheetObject("CH12").CopyTableToClipboard True
XLApp.Worksheets(1).Range("A16").Select()
XLApp.Worksheets(1).PasteSpecial
XLApp.Worksheets(1).Cells.EntireColumn.AutoFit
XLApp.Worksheets(1).Cells.EntireRow.AutoFit
XLApp.Worksheets(1).cells.WrapText = false
'Table2
ActiveDocument.GetSheetObject("CH14").CopyTableToClipboard True
XLApp.Worksheets(1).Range("A42").Select()
XLApp.Worksheets(1).PasteSpecial
XLApp.Worksheets(1).Cells.EntireColumn.AutoFit
XLApp.Worksheets(1).Cells.EntireRow.AutoFit
XLApp.Worksheets(1).cells.WrapText = false
'XLApp.Worksheets(1).Columns("A:A").Select
' "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
'XLApp.Worksheets(1).Range("A25:I38").Select
'Table3
ActiveDocument.GetSheetObject("CH13").CopyTableToClipboard True
XLApp.Worksheets(1).Range("A76").Select()
XLApp.Worksheets(1).PasteSpecial
'XLApp.Worksheets(1).Cells.Style = "20% - Accent1"
'Selection.Interior.ColorIndex = 2
'XLApp.Worksheets(1).Cells.Interior.ColorIndex = xlNone
XLApp.Worksheets(1).Cells.Interior.ColorIndex = 2
XLApp.Worksheets(1).Cells.EntireColumn.AutoFit
XLApp.Worksheets(1).Cells.EntireRow.AutoFit
XLApp.Worksheets(1).cells.WrapText = false
XLApp.Worksheets(1).Range("A16:J100").NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
XLApp.Worksheets(1).Range("F:F").NumberFormat = "0%"
XLApp.Worksheets(1).Range("I:I").NumberFormat = "0%"
'Graph2
ActiveDocument.GetSheetObject("CH26").CopyBitmapToClipboard
XLApp.Worksheets(1).Range("A111").Select()
XLApp.Worksheets(1).Paste
'Graph3
ActiveDocument.GetSheetObject("CH25").CopyBitmapToClipboard
XLApp.Worksheets(1).Range("A147").Select()
XLApp.Worksheets(1).Paste
'Graph4
ActiveDocument.GetSheetObject("CH27").CopyBitmapToClipboard
XLApp.Worksheets(1).Range("A181").Select()
XLApp.Worksheets(1).Paste
'Graph5
ActiveDocument.GetSheetObject("CH24").CopyBitmapToClipboard
XLApp.Worksheets(1).Range("A216").Select()
XLApp.Worksheets(1).Paste
XLApp.Worksheets(1).Range("A1").Select()
'Save as and Quit
XlDoc.SaveAs (strFileName) 'fileformat:=56
XlApp.Quit
End if
Next
End sub
function XLSheet(ExcelDoc,SheetName,ChartName,Category)
set obj = ActiveDocument.GetSheetObject(ChartName)
obj.CopyTableToClipboard true
ExcelDoc.Sheets(SheetName).PasteSpecial
ExcelDoc.Sheets(SheetName).Columns("A:A").ColumnWidth = 100
ExcelDoc.Sheets(SheetName).cells.select
ExcelDoc.Sheets(SheetName).columns.select
ExcelDoc.Sheets(SheetName).cells.mergecells = false
ExcelDoc.Sheets(SheetName).Cells.EntireRow.AutoFit
ExcelDoc.Sheets(SheetName).Cells.EntireColumn.AutoFit
ExcelDoc.Sheets(SheetName).name = Category
end function
Hi,
Do the following settings in Macro Module
Requested Module Security ---- > System Access
Current Local Security --- > Allow System Access
Above settings would allow you to create object.
Regards
Sridhar
That was it. Many thanks.
Hi,
I have one more question. If you do this, the header is not coming over, only the chart itself is copied.
Do you know if it is possible to copy the whole chart?
TNX!
The charts are copied as picture objects and you could do the same for the tables containing numbers but the it won't be editable in excel.
Use CopyBitmapToClipboard for everything.