I'm trying to do the following using vba:
I automatically gather data in Excel and want to paste it in an existing PowerPoint-Chart.
It is working fine, that's the way i do it (the paste-to-powerpoint-part):
Dim myChart As PowerPoint.Chart
Dim myChart As PowerPoint.Chart
Dim myData As PowerPoint.ChartData
Dim myWkb As Excel.Workbook
Dim myWks As Excel.Worksheet
Dim wbcd As Workbook
For chnmb = 1 To 1000
On Error Resume Next
Set myChart = ppSlide.Shapes(chnmb).Chart
'test_name = myChart.Name
If myChart.Name = "" Then Else Exit For
Next
I am doing this above (surely not the perfect way) because I don't know the Chart-Name (it is supposed to work for different Charts in different ppt-Files). After that:
Set myData = myChart.ChartData
Set myWkb = myData.Workbook
Set myWks = myWkb.Worksheets(1)
dat_area = "A1:" & Cells(1 + rowct, 1 + colct).Address(RowAbsolute:=False, ColumnAbsolute:=False)
myWks.ListObjects(1).Resize myWks.Range(dat_area)
That is the part not working.
I manage to fill data into the Chart using:
myWks.Cells(j, i).Value = Workbooks("ppt-tool.xlsm").Sheets("Acc_Data").Cells(Row + j, 1 + i).Value
(via for-next; I don't want to paste the data but fill in every field) and to later edit the Chart, but it won´t change the data-area (with the blue border around it) of the ppt-Chart.
Strangely, if I create a new Chart using
Set myChart = ppSlide.Shapes.AddChart2(297, xlBarStacked100).Chart
I manage to resize the data area (with the same resize-code), but it's not working with existing Charts. Incidentally, I don't want to link the ppt-Chart to Excel (because the Excel-Tool is used over and over again with no data saved and the ppt-Charts may have to be edited later again).
Related
I want to resize a chart table in PowerPoint via VBA. I've read the following solution multiple times (Resize Listobject Table dynamically with VBA) and it does seem precisely what I need, but for some reason (maybe because I'm running the macro from PowerPoint) it gives me the following error: Automation error (Error 440).
I plan to use the Resize method because I'm updating a PPT chart data table from another Excel file without using the .Activate method (I opted to not use the .Activate because it opened many charts workbooks after the Macro finished execution, even with multiple Waits and Excel.Application.Quit and .Close).
It works great, the charts workbooks do not flash on the screen and the values are copied fast, BUT... the table size is not correct. It only includes the 1st line of the ppt chart data table, and thus my chart is rendered incomplete.
Dim Line As Range Dim financialPartner As String, financialProject As String
financialPartner = excl.Workbooks("HNK-Status-CDAU.xlsx").Sheets("Financial").Cells(int_lin, 2)
financialProject = excl.Workbooks("HNK-Status-CDAU.xlsx").Sheets("Financial").Cells(int_lin, 3)
Dim found As Boolean
found = False
Dim lastRow As Long
Dim financialChart As Chart
Dim financialChartData As Range
Dim financialChartTable As ListObject
Dim financialChartTablews As Worksheet
lastRow = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart.chartData.Workbook.Sheets(1).Range("A1048576").End(xlUp).Row
Set financialChart = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart
Set financialChartTablews = ActiveWindow.Selection.SlideRange.Shapes("RevenuesVolume").Chart.chartData.Workbook.Worksheets(1)
Set financialChartTable = financialChartTablews.ListObjects("Tabela1")
For Each Line In chartDataTable.DataBodyRange.Rows
Dim lineNumber As Long
lineNumber = Line.Row
If ((Line.Columns(1) <> financialPartner) Or (Line.Columns(2) <> financialProject)) And found Then
Exit For
End If
If (Line.Columns(1) = financialPartner) And (Line.Columns(2) = financialProject) Then
found = True
With financialChart.chartData
Set financialChartData = .Workbook.Worksheets(1).ListObjects(1).Range
financialChartData.Range("A" & lastRow).Value = chartDataWs.Cells(lineNumber, 4)
financialChartData.Range("B" & lastRow).Value = chartDataWs.Cells(lineNumber, 5)
financialChartData.Range("C" & lastRow).Value = chartDataWs.Cells(lineNumber, 6)
lastRow = lastRow + 1
financialChartTable.Resize Range("A1:C" & lastRow)
.Workbook.Close
End With
End If
Next
Next
I am trying to make a fairly easy macro to activate the next series in an already active chart. (my main macro contains all the formatting stuff).
Problem with this coding, is that i am not able to assign the current active series (already selected in the graph in excel). In a graph with n series (SeriesCollection.Count = n) I want to go from x, to x+1 and if x=n i want to go back to series 1 (so the for/next included here is not necessary if I get the macro to work as intended).
Sub NextButton_Click()
Dim cht As Chart
Set cht = ActiveChart
If cht Is Nothing Then
MsgBox "Select a chart."
Exit Sub
End If
With cht
For SrsIndx = 1 To .SeriesCollection.Count
.SeriesCollection(SrsIndx).Select
Next SrsIndx
End With
End Sub
For Simple graphs, just use PlotOrder: If you are not using a Combo Chart (i.e. not mixing Line and Bar charts, and not using the Secondary Axis), then you can just use the following code:
IIF(TypeName(Selection)="Series", Selection.PlotOrder, -1)
This will return -1 if you do not have a Series selected.
However, this is actually the order within the ChartGroup - the conditions above were for when there is only 1 ChartGroup on the Chart.
Otherwise, try using Name and a loop:
Function ActiveSeriesNumber(ThisSeries AS Series) AS Long
Dim ThisChart AS Chart, TestNumber AS Long
ActiveSeriesNumber = -1
On Error GoTo FunctionError
Set ThisChart = ThisSeries.Parent.Parent 'Object Model Is Chart.ChartGroup.Series
For TestNumber = 1 to ThisChart.SeriesCollection.Count
If ThisChart.SeriesCollection(TestNumber).Name = ThisSeries.Name THen
ActiveSeriesNumber = TestNumber
Exit Function
End If
Next TestNumber
FunctionError:
On Error GoTo -1
End Function
Use this by calling ActiveSeriesNumber(Selection)
Here's the General Idea. Step through that code and you can see each series gets selected. You'll need add some object validation as this assumes the selected object is a Series.
Sub CycleSeries()
Dim MyObject As ChartObject
Dim MyChart As Chart
Dim SerCol As SeriesCollection
Dim SelSeries As Series
Dim indexSeries As Series
Dim ChartSheet As Worksheet
Dim x As Integer
Set ChartSheet = ThisWorkbook.Sheets(1)
Set MyObject = ChartSheet.ChartObjects(1)
Set MyChart = MyObject.Chart
Set SerCol = MyChart.SeriesCollection
Set SelSeries = Excel.Application.Selection
For x = 1 To SerCol.Count
Set indexSeries = SerCol(x)
If indexSeries.Name = SelSeries.Name Then
If (x = SerCol.Count) Then
Set SelSeries = SerCol(1)
SelSeries.Select
Exit For
Else
Set SelSeries = SerCol(x + 1)
SelSeries.Select
Exit For
End If
End If
Next x
End Sub
Using MS Word (in my case 2010 version), I have constructed a form with Content Control elements to be filled out by the user. Now I want certain entries (that I already gave titles to) be shown in a chart inside the same Word document (not in a separate Excel document).
This should be an automated process, so that if the user changes one of the Content Control entries, the chart updates itself automatically; I would also be OK if the user had to press a button in order to update the chart (but the user shouldn't have to click around a lot, since I must assume the user to have little skills.)
So I inserted an Excel chart object in my Word form document. I also wrote some VBA code inside this Excel object to read the Content Control values from the Word document as source for the chart. But I think what I really need is the VBA code to be in my Word document itself (for example to be executed upon click on a button by the user), yet I don't know how to address the Excel chart object and the cells within.
My VBA code inside the Excel object is:
Sub ChartDataAcquirer()
Dim wdApp As Object
Dim wdDoc As Object
Dim DocName As String
Dim ccX As String
Dim ccY As String
Dim datapairs As Integer
'''''''''' Variables '''''''''
DocName = "wordform.docm"
ccX = "titleX"
ccY = "titleY"
datapairs = 5
''''''''''''''''''''''''''''''
Set wdApp = GetObject(, "Word.Application")
Set wdDoc = wdApp.Documents(DocName)
Dim i As Integer
For i = 1 To datapairs
With ActiveSheet.Cells(i + 1, 1) ' The first row contains headline, therefore i+1
.Value = wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text ' The CC objects containing the x values have titles "titleX1", "titleX2" ..., therefore "ccX & i"
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text) ' To transform text into numbers, if user filled the CC object with numbers (which he should do)
End With
With ActiveSheet.Cells(i + 1, 2)
.Value = wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text)
End With
Next
End Sub
I guess I need a similar code that is placed in and operates from the Word form document itself, but that is where I am stuck...
The following is demo code that shows how to access an embedded Excel chart.
Note that the Name (Shapes([indexValue])) of your chart Shape is probably different than in this code. You'll need to check and change that assignment. Also, your chart may be an InlineShape rather than a Shape, so you may need to adjust that bit, as well.
This code checks whether the Shape is actually a chart. If it is, the Chart object is accessed as well as its data sheet. Via that, it's possible to get the actual workbook, the worksheets, even the Excel application if you should need it.
Sub EditChartData()
Dim doc As Word.Document
Dim shp As Word.Shape
Dim cht As Word.Chart
Dim wb As Excel.Workbook, ws As Excel.Worksheet, xlApp As Excel.Application
Set doc = ActiveDocument
Set shp = doc.Shapes("MyChart")
If shp.HasChart Then
Set cht = shp.Chart
cht.ChartData.Activate
Set wb = cht.ChartData.Workbook
Set xlApp = wb.Application
Set ws = wb.ActiveSheet
Debug.Print ws.Cells(1, 2).Value2
End If
Set ws = Nothing
Set wb = Nothing
Set cht = Nothing
Set xlApp = Nothing
End Sub
I have a presentation and I have to update it every week. The information I update are a bunch of imagens I generate from a Excel pivot tables (copy from Excel and paste directly on PowerPoint).
Today I can do this doing this:
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PPTPrez =
objPPT.Presentations.Open("\\network_folder\presentation.pptm")
Set pSlide = PPTPrez.Slides(2)
If pSlide.Shapes.Count <> 0 Then
ActiveWorkbook.Sheets("Pivot1").Range("A8:Z18").CopyPicture
pSlide.Shapes.Paste
EndIf
It work flawless... But I need a litle bit more control and precision...
I need to select the current image on slide, delete it and paste the new one in the same location... Some slides have 3 images or more...
I cann't figure it out how to properly tell to VBA what image are what and choose the pivot table with the correct info for that image... I don't even know if this is possible...
But another solution I have tried is how to specify the position and dimensions of the image on the slide... I can before update, delete all imagens... In this scenario, how to specify the dimensions and positioning?
Thanks!!!
Ps.: Sorry my bad english
This example (based on your code) may point you in the right direction. You need to know the powerpoint shape name (which you can get via VBA or via the ribbon Home-Select-Selection Pane.
Option Explicit
Public Sub UpdateShapes()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As Presentation
Dim vSlide As Slide
Dim vShapeName As String
Dim vShape, vNewShape
Set vPowerPoint = New PowerPoint.Application
vPowerPoint.Visible = True
' Open the powerpoint presentation
Set vPresentation = vPowerPoint.Presentations.Open("\\network_folder\presentation.pptm")
' Set slide to be worked on
Set vSlide = vPresentation.Slides(2)
' Set shape to (for this example) "Picture 3"
vShapeName = "Picture 3"
Set vShape = vSlide.Shapes(vShapeName)
' Copy and paste new shape (picture) of range specified
ThisWorkbook.Sheets("Sheet1").Range("A6:B9").CopyPicture
Set vNewShape = vSlide.Shapes.Paste
' Align size and position of new shape to that of old shape
With vNewShape
.Width = vShape.Width
.Height = vShape.Height
.Left = vShape.Left
.Top = vShape.Top
End With
' Delete original shape, rename new shape to original so code works next replace cycle
vSlide.Shapes(vShapeName).Delete
vNewShape.Name = vShapeName
End Sub
I've been trying below code to copy chart as picture, and paste it in another sheet without selection/activate. however it does not seem to paste the picture into the range:
Dim Range_DriverLookup As Range, RowCounter_DriverLookup As Long
Dim Count_DeliveredServicesNumber As Long, Counter_DeliveredServicesNumber As Long
Dim Cht_SitePotential As ChartObject
Dim Cht_Top5 As ChartObject
Dim Cht_RegionalPeerGroup As ChartObject
Dim PvtTbl_SitePotential As PivotTable
Dim PvtTbl_Top5 As PivotTable
Dim PvtTbl_RegionalPeerGroup As PivotTable
Dim Graph_PerformanceReport As Excel.Picture
'''''''''''''''''''''''''''''''''''''''''
' Assign ranges, pivottables and charts '
'''''''''''''''''''''''''''''''''''''''''
Set Range_DriverLookup = ThisWorkbook.Worksheets(SheetDriverLookup.Name).ListObjects("DriverLookup").DataBodyRange
Set PvtTbl_SitePotential = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableSitePotential")
Set PvtTbl_Top5 = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableTop5")
Set PvtTbl_RegionalPeerGroup = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableRegionalPeerGroup")
Set Cht_SitePotential = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartSitePotential")
Set Cht_Top5 = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartTop5")
Set Cht_RegionalPeerGroup = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartRegionalPeerGroup")
'''''''''''''''''''''''''''''''''''
' Initiate new performance report '
'''''''''''''''''''''''''''''''''''
'// Clear previous graphs
For Each Graph_PerformanceReport In ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Pictures
Graph_PerformanceReport.Delete
Next Graph_PerformanceReport
'// Clear previous sheet setup, and initiate new
Stop
With ThisWorkbook.Worksheets(SheetPerformanceReport.Name)
'/ Unhide rows in PerformanceReport
.Cells.EntireRow.Hidden = False
'/ Clear previous "table of content"
.Range("TableOfContent").ClearContents
'/ Reset pagebreaks and set for new frontpage
.ResetAllPageBreaks
.Rows(71).PageBreak = xlPageBreakManual
End With
'// Set filters on frontpage graph
PvtTbl_SitePotential.ClearAllFilters
PvtTbl_SitePotential.PivotFields("Serviceline").AutoSort Order:=xlDescending, Field:="Potential Savings (Yearly) "
PvtTbl_SitePotential.PivotFields("Serviceline").ShowDetail = False
PvtTbl_SitePotential.PivotFields("Site").PivotFilters.Add Type:=xlCaptionEquals, Value1:=ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("Site").Value
PvtTbl_SitePotential.PivotFields("Serviceline").PivotFilters.Add _
Type:=xlValueIsGreaterThanOrEqualTo, DataField:=PvtTbl_SitePotential.PivotFields("Potential Savings (Yearly) "), Value1:=5000
'// Create title for frontpage graph
With Cht_SitePotential.Chart.ChartTitle
.Caption = ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("Site") & " - Yearly Potential on Service Level"
End With
'// Paste frontpagegraph to PerformanceReport
With Cht_SitePotential.Chart
.ChartArea.Copy
End With
ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("D7:D7").PasteSpecial xlPasteValues
Edited with larger part of the code.
I'ts working for me when I simulated .Range("Frontpage_Graph") with "P1:P1"
ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("P1:P1").PasteSpecial ppPasteEnhancedMetafile
ppPasteEnhancedMetafile will give a better resolution chart picture.
If you use a range like "P10:Z20" it will just use P10 as the anchor point of the Chart picture.