I have the following code which let me copy
Sub pptCopy()
Dim pptapp As PowerPoint.Application
Dim ppt As PowerPoint.Presentation
Dim slide As PowerPoint.slide
Dim shape1 As PowerPoint.shape
var2 = "C:\Documents and Settings\aa471714\Desktop\Presentation2.pot"
Set pptapp = CreateObject("Powerpoint.Application")
Set ppt = pptapp.Presentations.Open(var2)
Set slide = ppt.Slides(2)
Set shape1 = slide.Shapes.Paste(1)
pptapp.Visible = True
Call copyExcel1
With shape1
.Left = 100
.Width = 100
End With
End Sub
And an another macro
Sub copyExcel1()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim cht As Excel.ChartObject
var2 = "C:\Documents and Settings\aa471714\Desktop\Template.xls"
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open(var2)
oExcel.Visible = True
Sheets("Sheet5").ChartObjects("AchmeaBankNL").Chart.ChartArea.Copy
End Sub
I however have two issues:
I want to move the excel picture to a specific place in powerpoint (fe shape 3)
I want to copy more than excel figure (i need to copy 2, one to shape 3 and one to shape 4).
Does anybody know how I should edit code below to accomplish this?
Dear regards,
Marc
First, you should edit the subject of your question; it doesn't seem to have anything to do with the question itself.
To move the shape to a specific position in the "stacking" order, use something like this function:
Function ShapeToZOrder(oSh As Shape, lPosition As Long)
oSh.ZOrder msoSendToBack
Do Until oSh.ZOrderPosition = lPosition
oSh.ZOrder msoBringForward
Loop
End Function
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
I tried to figured out why the coding is not working, but the following code was supposed to open from excel a powerpoint and clear the existing slides in order to replace with new picture - however I'm getting the following:
error 91: Object variable or with block variable not set.
I tried several others code from the Stack but cannot make it work.. any help please? The deck contains slide 2 to slide 9 to cleared out.
Sub ppt_export()
Dim DestinationPPT As String
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim objApp As Object, objSlide As Object, ObjShp As Object, objTable As` Object
DestinationPPT = "C:\Users\\Desktop\Summary.pptx"
Set ppApp = CreateObject("PowerPoint.Application")
Set ppPres = ppApp.Presentations.Open(DestinationPPT)
'delete the shapes from the renew the template
For i = ppSlide.Shapes.Count To 1 Step -1
Set ppShape = ppSlide.Shapes(p)
If ppShape.Type = msoPicture Then ppShape.Delete
Next
End Sub
I'd like to know how to correct the code in order to continue the coding with copying excel worksheets as pictures into the respective slide.
First and most importantly, add Option Explicit to the top of the code module, and it will flag the various undeclared variables you have: p, i, ppSlide, and ppShape.
Then the code might look something like this:
Option Explicit
Sub ExportToPPT()
Dim ppApp As PowerPoint.Application
Set ppApp = New PowerPoint.Application
Dim ppFileName As String
ppFileName = "C:\Users\\Desktop\Summary.pptx"
Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Open(Filename:=ppFileName)
Dim ppSlide As PowerPoint.Slide
Dim i As Integer
For i = 2 To 9
Set ppSlide = ppPres.Slides(i)
Dim j As Integer
For j = ppSlide.Shapes.Count To 1 Step -1
If ppSlide.Shapes(j).Type = msoPicture Then
ppSlide.Shapes(j).Delete
End If
Next j
Next i
End Sub
I need to find a way to extract chart data labels from a PowerPoint chart to Excel, as many times the PowerPoint chart given to me has it's linked data broken.
I wrote the code below, but I have no clue what to do after For Each datapoint In chtnow.SeriesCollection(1).Points...
Sub Extract_Datalabels()
'Goal: To extract datalabels of Chart's series collection and write to excel
Dim datapoint As Point
Dim sh As Shape
Dim sld As Slide
Dim chtnow As Chart
Dim label As DataLabel
Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlworksheet As Excel.Worksheet
Set xlWorkbook = xlApp.Workbooks.Add
Set xlworksheet = xlWorksheets.Add
xlApp.Visible = True
Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
For Each datapoint In chtnow.SeriesCollection(1).Points
'Extract data labels
If datapoint.HasDataLabel Then
[No clue how to write to Excel]
End If
Next
End Sub
If everything else works ok with the code, this is an easy way to write to the first column of the xlworksheet in excel:
Dim cnt As Long
If datapoint.HasDataLabel Then
cnt = cnt + 1
xlworksheet.Cells(cnt, 1) = datapoint.label
End If
However, I am not sure that after setting xlApp.Visible = True you would be allowed to do something like this Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart.
You had a couple of type errors with your example, but this should get the job done for you. You will need to add a reference to the Microsoft Excel [A Number] Object Library in order to use the Excel object type and all derivatives.
All testing was done using a bar chart.
Sub Extract_Datalabels()
''Goal: To extract datalabels of Chart's series collection and write to excel
Dim datapoint As ChartPoint
Dim chtnow As Chart
Dim xlApp As New Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlworksheet As Excel.Worksheet
Dim Row As Long
Let xlApp.SheetsInNewWorkbook = 1
Set xlWorkbook = xlApp.Workbooks.Add
Set xlworksheet = xlWorkbook.Worksheets(1)
Let xlApp.Visible = True
Call VBA.DoEvents
Set chtnow = ActiveWindow.Selection.ShapeRange(1).Chart
Let Row = 1
For Each datapoint In chtnow.SeriesCollection(1).Points
'Extract data labels
If datapoint.HasDataLabel Then
Let xlworksheet.Cells(Row, 1) = datapoint.DataLabel.Text
End If
Let Row = Row + 1
Next
End Sub
I need to update a label caption using Powerpoint object from excel macro. I cant able to update.
Dim objPpt As PowerPoint.Application
Dim objPre As Presentation
Dim objSlide As Slide
Dim objLayout As CustomLayout
Dim objTxtBox As Shape
Set objPpt = CreateObject("Powerpoint.Application")
Set objPre = objPpt.Presentations.Open("H:\Macro\SamplePpt.pptm")
ActivePresentation.Slides(1).lblHi.Caption = "Hello"
Set objSlide = objPre.Slides.Item(1)
Set objTxtBox = objSlide.Shapes.Item(1)
lblHi.Caption = "Hello"
Help me to do this....!!!!
With the help of below coding, I am able to open the powerpoint file but it is not updating the textbox.
I am getting an error as "Object variable or with block variable not set".
Dim PPT As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim newslide As PowerPoint.Slide
Dim slideCtr As Integer
Dim tb As PowerPoint.Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
Set pres = PPT.Presentations.Open( _
"C:\Users\GShaikh\Desktop\Process Coach certificate template.pptx")
slideCtr = 1
Set tb = newslide.Shapes("TextBox1")
tb.TextFrame2.TextRange.Characters.Text = "OK"
Try:
PPT.ActivePresentation.Slides(2).Shapes("TextBox1").TextFrame.TextRange.Characters.Text = "qwerty"
To get the name of the shape just right (in an input box so that you can copy it), select it and run:
a = InputBox("The name of the selected shape is:", "Name of the Shape", PPT.ActiveWindow.Selection.ShapeRange.Name)
to change it, while you have it selected, try:
PPT.ActiveWindow.Selection.ShapeRange.Name = "TextBox2"
Hope this helps.
Error is taking place on the Set tb line because you never initialize newslide, or at least you don't show it here.
Assuming your text box is on slide one you can do something like the following (add before Set tb):
Set newslide = pres.Slides(1)
Also make sure the text box you want is actually "TextBox1". By default the names usually have a space before the number like "TextBox 1".
I tested your code with this change to verify it works. Full code here:
Sub test()
Dim PPT As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim newslide As PowerPoint.Slide
Dim slideCtr As Integer
Dim tb As PowerPoint.Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
Set pres = PPT.Presentations.Open( _
"C:\Users\GShaikh\Desktop\Process Coach certificate template.pptx")
slideCtr = 1
Set newslide = pres.Slides(1)
Set tb = newslide.Shapes("TextBox1")
tb.TextFrame2.TextRange.Characters.Text = "OK"
End Sub