I copied chart (this chart with legend I prepared in excel) from excel to .ppt (below code). How can I change/edit legend.Top and legend.size?
My code is not working...
Sub pptfromexcel()
Dim pptapp As PowerPoint.Application
Dim pptppt As PowerPoint.Presentation
Dim pptsld As PowerPoint.Slide
Dim shp As Object
Set chart1 = ActiveSheet.ChartObjects("Chart 1")
'Dane do wykresów
Set d5 = Sheets("Wykresy").Range("Q32:S40")
Set d6 = Sheets("Wykresy").Range("Q47:S51")
Set v1PK = Sheets("Wykresy").Range("G7:G7")
Set v1PM = Sheets("Wykresy").Range("G8:G8")
Set pptapp = New PowerPoint.Application
Set pptppt = pptapp.Presentations.Open("C:\Users\Desktop\ppt.pptx")
pptapp.Visible = True
pptapp.Activate
Set pptsld2 = pptppt.Slides(2)
chart1.Copy
Set chart1a = pptsld2.Shapes.PasteSpecial
With chart1a
.Height = 132
.Width = 157
.Left = 26.1
.Top = 120
.haslegend=true
.legend.size = 12
.legend.top = 150
End With
End Sub
The first four properties your are setting are generic properties for all shapes. The legend properties are specific for a chart. The first thing that must happen is that it is pasted as an Excel object. If that is the case, you have a Chart property on your shape and you can do like this:
With chart1a
.Height = 132
.Width = 157
.Left = 26.1
.Top = 120
.Chart.HasLegend = True
.Chart.Legend.Size = 12
.Chart.Legend.Top = 150
End With
Related
I am trying to create an excel vba macro that loops through each slide in a presentation (the presentation was created with an excel vba macro) and adds specific text to the top of each slide.
Right now, this is what I have but it is throwing an error and I can figure out the set slide_title section and the with section. I think the for loop is correct, but not understanding the "with" section. The "with" section text box characteristics are correct....but the code isn't executing because something is clearly wrong with it.
Sub update_slide_title_text()
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
ppt.Visible = msoCTrue
ppt.Presentations.Open ("C:\Users\Existing_Presentation.pptx")
Dim ppres As PowerPoint.Presentation
Set ppres = ppt.ActivePresentation
Dim pslide As PowerPoint.Slide
Dim pshape As PowerPoint.Shape
For Each pslide In ppres.Slides
Dim slide_title As Object
Set slide_title = pslide.Shapes.AddTextbox(1, 34.36292, -2.670787, 900, 90)
With slide_title
.Height = 54
.Left = 34.36292
.Top = 15
.Width = 190
.TextFrame.TextRange.Text = "NEED TO CHANGE THIS TO DIFFERENT TEXT FOR EACH SLIDE"
.TextFrame.TextRange.Font.Bold = True
.TextFrame.TextRange.Font.Size = 20
.TextFrame.TextRange.Font.Color = RGB(0, 133, 85)
End With
Next
End Sub
(Post updated with entire code, sorry about the beginner mistake)
Newbie to both coding and VBA here and I'm trying to adjust the PlotArea for a Chart in a presentation. I'm running this from Excel.
Creating and populating the Chart goes fine, sizing ChartArea is also no problems and formating all titles etc is also without problems.
When the Chart looks athe way I want it to, is the correct size and at the correct place, I want the PlotArea to be a precise size and in a precise location. Sizing goes well but the position does not work.
Here is the code that I use, Including populating the ChartData with dummy data and adding in a red box to show where I want the PlotArea to sit:
Sub CreateChart()
'Declare Excel Object Variables
Dim pptWorkBook As Excel.Workbook
Dim pptWorkSheet As Excel.Worksheet
'Declare PowerPoint Object Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim PPTShape As PowerPoint.Shape
Dim PPTChart As PowerPoint.Chart
Dim PPTChartData As PowerPoint.ChartData
Dim SldHeight, SldWidth As Integer
Dim ChrHeight, ChrWidth As Single
Dim PlotHeight, PlotWidth As Double
'Declare Excel Object Variable
Dim ExcRange As Range
'Create a new instance of Powerpoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
'Create a new Presentation within the Application
Set PPTPres = PPTApp.Presentations.Add
'Disable Snap-To-Grid
PPTPres.SnapToGrid = msoFalse
'Create a new slide within the Presentation
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'Find out size (points) of Slide
SldHeight = PPTPres.PageSetup.SlideHeight
SldWidth = PPTPres.PageSetup.SlideWidth
'Calculate Chart and Plot Size
ChrWidth = 954
ChrHeight = 525 - 106
PlotWidth = 866 - 95
PlotHeight = 437 - 106 - 20
'No screen updates
Application.ScreenUpdating = False
'Create a new Chart within the Slide, give it proper size
Set PPTShape = PPTSlide.Shapes.AddChart2(-1, xlColumnClustered, 0, 106, ChrWidth, ChrHeight, True)
'Minimize ChartData
PPTShape.Chart.ChartData.Workbook.Application.WindowState = -4140
'Set chartdata
Set PPTChartData = PPTShape.Chart.ChartData
'Set Workbook object reference
Set pptWorkBook = PPTChartData.Workbook
'Set Worksheet object reference
Set pptWorkSheet = pptWorkBook.Worksheets(1)
'Add Data
pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
pptWorkSheet.Range("b1").Value = "Items"
pptWorkSheet.Range("a2").Value = "Bikes"
pptWorkSheet.Range("a3").Value = "Accessories"
pptWorkSheet.Range("a4").Value = "Repairs"
pptWorkSheet.Range("a5").Value = "Clothing"
pptWorkSheet.Range("b2").Value = "1000"
pptWorkSheet.Range("b3").Value = "2500"
pptWorkSheet.Range("b4").Value = "4000"
pptWorkSheet.Range("b5").Value = "3000"
'Apply Style
With PPTShape.Chart
.ChartStyle = 4
End With
'Remove title
With PPTShape.Chart
.HasTitle = False
End With
'Format legend
With PPTShape.Chart
.HasLegend = True
.Legend.Position = xlLegendPositionTop
.Legend.Top = 0
End With
'Add axis title
With PPTShape.Chart.Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "Dollars"
End With
'Remove gridlines
With PPTShape.Chart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
'Add data labels
PPTShape.Chart.ApplyDataLabels
'Set PlotArea position and size
With PPTShape.Chart.PlotArea
.InsideLeft = 95
.InsideTop = 20
.InsideWidth = PlotWidth
.InsideHeight = PlotHeight
End With
'Adding a red textbox with the same dimensions and position as the PlotArea
With PPTShape.Chart.Shapes.AddTextbox(msoTextOrientationDownward, 95, 20, PlotWidth, PlotHeight)
.Line.Weight = 2
.Line.DashStyle = msoLineLongDash
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
'Quit
Set pptWorkSheet = Nothing
pptWorkBook.Application.Quit
Set pptWorkBook = Nothing
Set PPTChartData = Nothing
Set PPTChart = Nothing
'Screen updates
Application.ScreenUpdating = True
End Sub
Below you can see the result with dummy data. The red box is correct, the PlotArea is the right size but not in the right position. Am I misunderstanding something regarding the InsideLeft vs Left properties? I've been stuck here for hours now and I am not making any progress. A theory a colleague and I have is that the PlotArea is doing a Snap-To to something that can't be seen.
Any help is appreciated!
UPDATE:
I changed the order of positioning and sizing of the PlotArea and it improved.
'Set PlotArea position and size
With PPTShape.Chart.PlotArea
.InsideWidth = PlotWidth
.InsideHeight = PlotHeight
.InsideLeft = 95
.InsideTop = 20
End With
The offset from the red box seems consistent and I'm sure it is a small thing I am missing somewhere. See attached image of the new result below.
UPDATE 2:
Here is how I solved this. I'm not entirely sure it is correct logic, but it works at least.
I need to offset the PlotArea by 3.9 points. This seems to involve spacing for TickMarks. My assumption here is that the PlotArea position (.InsideTop and .InsideLeft etc) include TickMark width and height but lacks the means to adjust for this. My workaround looks like this:
'Set the TickMark offset constant
offSet = 3.9
'Set PlotArea position and size
With theShape.Chart.PlotArea
.InsideWidth = PlotWidth
.InsideHeight = PlotHeight
.InsideLeft = 95 - offSet
.InsideTop = 20 - offSet
End With
As this is mostly guesswork, as far as a solution is concerned, any real answers and not workarounds would still be appreciated.
It seems you're trying to position the chart, not the plot area. Try something like this instead:
'Set PlotArea size and position
With PPTShape.Chart.PlotArea
.InsideWidth = PlotWidth
.InsideHeight = PlotHeight
.Left = 60
.Top = -25
End With
I use the following VBA to insert two buttons into my Excel sheet and group them together:
Sub Insert_Buttons()
Sheet1.Select
Dim Button_01 As Button
Set Button_01 = Sheet1.Buttons.Add(423.75, 0, 48, 15)
Dim Range_Button_01 As Range
Set Range_Button_01 = Sheet1.Range("B6:D7")
Button_01.Name = "Button_01"
With Button_01
.Top = 30
.Left = 76
.Width = 50
.Height = 20
.Text = "Button_01"
End With
Sheet1.Select
Dim Button_02 As Button
Set Button_02 = Sheet1.Buttons.Add(423.75, 0, 48, 15)
Dim Range_Button_02 As Range
Set Range_Button_02 = Sheet1.Range("B6:D7")
Button_02.Name = "Button_02"
With Button_02
.Top = 5
.Left = 76
.Width = 50
.Height = 10
.Text = "Button_02"
Sheet1.Shapes.Range(Array("Button_01", "Button_02")).Group
End Sub
All this works perfectly.
However, now I want to use another VBA to ungroup the buttons which I inserted with the above VBA. Therefore, I tried to go with the following:
Sub Ungroup_Buttons()
Sheet1.Shapes.Range(Array("Button_01", "Button_02")).Ungroup
End Sub
However, with this VBA I get runtime error 1004.
What do I need to change in my code so I can ungroup the buttons?
Maybe give this a try :
Sub Ungroup_Buttons()
Set ButtonList = Sheet1.Shapes.Range(Array("Button_01", "Button_02")).Group
ButtonList.Name= "ListToUnGroup"
Sheet1.Shapes.Range("ListToUnGroup").Ungroup
End Sub
I have created a template on excel which is populated with data for a specific country. The template contains 3 tables and a chart (line graph). I have a list of countries that I need to loop through, and for each loop, I need to create a powerpoint slide made up of the 3 tables and chart.
I build the macro below using bits from various sources (mostly from this platform). The macros scales and positions each of the elements. The first slide populates correctly, but I am running into the following issues:
All the tables and charts are positioned correctly on the first slide, but are not being positioned on every other slide. Note that the objects are still being scaled correctly
I get Run-time error ‘-214788160 (80048240): Selection (unknown member) : Invalid request. This view does not support selection
Does anyone have any suggestions for what the issue could be?
Sub MulipleCountrySlides()
'Step 1: Declare your variables
Dim ListOfSystems As Variant
Dim pptLayout As CustomLayout
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlides As PowerPoint.Slides
Dim PPSlide As PowerPoint.Slide
Dim SlideTitle As String
Dim XLS_Out As Variant
Dim shp As Object
Dim chtObj As ChartObject
Dim chtTop As Double
Dim chtLeft As Double
Dim chtWidth As Double
Dim chtHeight As Double
'Step 2: Open PowerPoint and create new presentation
Set PP = New PowerPoint.Application
Set PPPres = PP.Presentations.Add
PP.Visible = True
'Step 3: Add new slide as slide 1 and set focus to it
PPPres.ApplyTemplate "C:\Users\yogeswaran saravanan\AppData\Roaming\Microsoft\Templates\blank.potx"
ListOfSystems = Range("listofsystemstest") 'This is the list of systems that I will be looping through
For y = LBound(ListOfSystems) To UBound(ListOfSystems)
Set PPSlide = PPPres.Slides.Add(y, ppLayoutTitleOnly)
Worksheets("System output sheet").Range("j2").Value = ListOfSystems(y, 1)
Sheets("Indexed data").Calculate
ActiveSheet.Calculate
If Not Application.CalculationState = xlDone Then ' Calculation takes a while to run
DoEvents
End If
Set PPSlide = PPPres.Slides(y)
'The following arrays specify the regions/charts to be copied/pasted,
'the sizes/positions of these regions/charts, and the slide numbers corresponding
'to region/chart destinations
'Region/chart widths (Length/width ratios are preserved)
OWidth = Array(910, 450, 900, 465) '' 72px per Inch
OHeight = Array(400, 120, 33, 147)
'Horizontal positions on slides
OLeft = Array(22, 22, 22, 22)
'Vertical positions on slides
OTop = Array(100, 360, 504, 200)
'Regions and charts to be copied/pasted
XLS_Out = Array(Range("Countryslidetable"), _
Range("Chartdeltas"), _
Range("Countryfootnote"), _
Worksheets("System output sheet").ChartObjects("Chart 1"))
'Region/Chart type: 1 corresponds to chart objects, 0 corresponds to regions
XLS_OutFormat = Array(0, 0, 0, 1)
'Loop through arrays and copy/paste regions and charts one at a time
For x = 0 To 3 'LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel range/chart
XLS_Out(x).Copy
'Paste to PowerPoint
If (XLS_OutFormat(x) = 0) Then
'Paste an Excel range
Set shp = PPPres.Slides(y).Shapes.PasteSpecial(ppPasteHTML)
Else
'Paste an Excel chart
Set shp = PPPres.Slides(y).Shapes.PasteSpecial(ppPasteShape)
shp.LinkFormat.BreakLink
End If
'Change position/size of pasted regions/charts based on previously-defined arrays
With PPPres.Slides(y)
'shp.LockAspectRatio = msoTrue
shp.Height = OHeight(x)
shp.Width = OWidth(x)
shp.Top = OTop(x)
shp.Left = OLeft(x)
shp.ZOrder msoSendToFront
'End With
If (XLS_OutFormat(x) = 0) Then
If (x = 2) Then
PP.ActiveWindow.Selection.ShapeRange.TextEffect.FontSize = 10
End If
If (x = 0) Then
'Set oShp = PPSlide.Shapes(1)
'Set oShp = PP.ActiveWindow.Selection.ShapeRange
Set oTbl = shp.Table
For i = 1 To oTbl.Columns.Count
For J = 1 To oTbl.Rows.Count
'oShp.TextFrame.TextRange.Font.Size = 11
oTbl.Cell(J, i).Shape.TextFrame.TextRange.Font.Size = 11
Next
Next
End If
End If
End With
Next x
'Step 6: Add the title to the slide
SlideTitle = "Country Price Recommendations: " & Worksheets("System output sheet").Range("J2")
PPPres.Slides(y).Shapes.Title.TextFrame.TextRange.Text = SlideTitle
'Step 7: Memory Cleanup
PP.Activate
Next y
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
End Sub
I have problem resizing plot area in an embedded chart in excel
Dim myChart As Chart
maxPie = ThisWorkbook.Sheets(sheetName).Range("A1048576").End(xlUp).Row
Set myChart = ThisWorkbook.Sheets(sheetName).Shapes.AddChart.Chart
myChart.ChartType = xlBarClustered
myChart.SetSourceData Source:=Range(sheetName & "!$A$5:$C$" & maxPie)
With myChart.Parent
.Top = 10
.Left = 500
.Width = 500
.Height = 500
End With
With myChart.PlotArea
.Top = 70
.Height = 420
End With
if i press debug and then F5 then it resizes it, do I need to add a delay in my code because its not finished generating the plot area before I try to resize it
The comment Rory made about reading the value solved the issue, strange that this is needed though..
Dim temp As Integer
With myChart.PlotArea
temp = .Top
temp = .Height
.Top = 70
.Height = 420
End With
I think the problem why your code return error because PlotArea properies can only be modify after the Chart object if fully loaded. So yes, you need to complete Chart Object loading process and modify any PlotArea properties.
The code below will work. Try it..!
Option Explicit
Public Sub Demo()
Dim maxPie As Long
Dim myChart As Chart
'I assume that your chart is on Sheet1
maxPie = Sheet1.Range("A1048576").End(xlUp).Row
Set myChart = Sheet1.Shapes.AddChart2.Chart
With myChart
.ChartType = xlBarClustered
.SetSourceData Source:=Range("Sheet1!$B$2:$C$" & maxPie)
End With
With myChart.Parent
.Top = 10
.Left = 500
.Width = 500
.Height = 500
End With
'Delay the SetPlotArea code execution using OnTime function
Application.OnTime Now, "SetPlotArea", Now + TimeValue("0:0:5")
End Sub
Public Sub SetPlotArea()
Dim ch As Chart
Set ch = Sheet1.ChartObjects(1).Chart
ch.PlotArea.Top = 70
ch.PlotArea.Height = 420
End Sub