export graphic chart to excel

[#1]

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

[#2]

Even I am looking for this one..

[Anonymous · Accepted solution]

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

[#4]

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

[#5]

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

[#6]

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

[#7]

That was it. Many thanks.

[#8]

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!

[#9]

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.

[#10]

Use CopyBitmapToClipboard for everything.