I'm trying to write a macro that loops through all sheets in a excel workbook and if there is a chart It copy the chart to a new word document. The workbook consist of around 35 sheets and only half of them are populated with a chart. I want the code to jump to next sheet if there is no chart in it and if there is a chart copy it to Word and then move on to the next one. I am very new to VBA and coding in general and been experimenting a bit. I managed to get one chart from one sheet into word... I've tried a few different things and left that in as comments.
My code as today:
'Declare word object variables
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
'Declare excel Object variable
Dim WrkSht As Worksheet
Dim Chrt As ChartObject
Dim Cht_Sht As Chart
Dim wkBk As Workbook
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set the link to the location where the excel evaluation sheet is located, include file name in the link
Const Utvärdering As String = "C:\Users\A561004\OneDrive - AF\Desktop\Test\Utvärdering.xlsx"
'Open Excel Utvärdering...
Application.StatusBar = "Utvärdering"
Set wkBk = Workbooks.Open(Utvärdering)
' Select sheet based on name
Sheets(1).Select
'Create a new instance of Word
Set WordApp = New Word.Application
WordApp.Visible = True
WordApp.Activate
'Create a new word document
Set WordDoc = WordApp.Documents.Add
'Start a loop
For Each WrkSht In Sheets
'WrkSht.ChartObjects.Select
If ActiveSheet.ChartObjects.Count > 0 Then
For Each Cht_Sht In wkBk.Sheets(1).ChartObjects
Cht_Sht.ChartArea.ChartArea.Copy
'ActiveChart.ChartArea.Select
'ActiveChart.ChartArea.Copy
With Word.Application.Selection
.PasteSpecial Link:=False, DataType:=15
WordApp.ActiveDocument.Selections.Add
'Go to new page
WordApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
'Clear Clipboard
Application.CutCopyMode = False
End With
Next Cht_Sht
Else
WrkSht.Next.Activate
End If
'Test loop
'For each Cht_Sht in 2 To Sheets(ActiveWorkbook.Sheets.Count - 1)
'Create a Reference to the chart you want to Export
'ActiveChart.ChartArea.Select
'On Error Resume Next
'ActiveChart.ChartArea.Copy
'Paus application 2 sek
Application.Wait Now + #12:00:02 AM#
'Paste into WOrd Document
'With Word.Application.Selection
' .PasteSpecial Link:=False, DataType:=15
' End With
'New word page Problems here, need to set a new marker in the document for next paste
' WordApp.ActiveDocument.Selections.Add
'Go to new page
' WordApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
'Clear Clipboard
' Application.CutCopyMode = False
'End loop, or start next rotation of loop
Next WrkSht
'Optimise Code
Application.EnableEvents = True
On Error GoTo 0
End Sub
I'm sorry if it is a bit messy.
Aucun commentaire:
Enregistrer un commentaire