I'm having trouble pasting values from excel into a table in ppt. It gives me error in this last line, can anybody figure out why and how it can be improved?
Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim sl As PowerPoint.Slide
Dim sh As PowerPoint.Shape
Dim sh1 As PowerPoint.Shape
Dim r As Range
Dim filterRange As Range
Dim copyRange As Range
Dim lastRow As Long
Set ppt = New PowerPoint.Application
Set pres = ppt.Presentations.Open(ThisWorkbook.Path & "\Edenred_ProjectStatus_Saxo.pptx")
Set sl = pres.Slides(1)
Set sh1 = sl.Shapes("Table 3")
ThisWorkbook.Sheets("Action&Open_Point").Range("H1").AutoFilter field:=1, Criteria1:="Y"
lastRow = ThisWorkbook.Sheets("Action&Open_Point").Range("D" &
ThisWorkbook.Sheets("Action&Open_Point").Rows.Count).End(xlUp).Row
Set copyRange = ThisWorkbook.Sheets("Action&Open_Point").Range("D2:D" & lastRow)
ActiveWorkbook.Worksheets("Action&Open_Point").UsedRange.Font.Underline = False
copyRange.SpecialCells(xlCellTypeVisible).Copy
**sh1.TextFrame.TextRange.Paste**
It runs until "copy" but then it does not paste it on ppt. the error says it is out of range
Related
I currently have a larger table in excel that I am trying to copy/paste into an existing PPT doc. Since the table is too long to fit on one slide I'm trying to have it take every 15 rows and paste on a new slide. The code below works, but it is set up to take a specified range for each slide. I've tried several other ways, but they all end up opening the PPT doc and essentially doing nothing.
Sub ExcelToPowerPoint()
Dim PPapp As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPslide As PowerPoint.Slide
Dim Xlws As Worksheet
Dim rng As Range
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
Dim shp As Object
Dim i As Long
Dim j As Integer
Set Xlws = ActiveSheet
Set PPapp = New PowerPoint.Application
Set PPpres = PPapp.Presentations.Open("insert name of doc here")
PPapp.ActivePresentation.Slides(4).Select
PPapp.Activate
PPapp.Visible = True
'List of PPT Slides to Paste to
MySlideArray = Array(4, 5, 6)
'List of Excel Ranges to Copy from
MyRangeArray = Array(Sheets("Template").Range("B1:K16"), Sheets("Template").Range("B16:K31"), Sheets("Template").Range("B31:K45"))
'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy
On Error Resume Next
Set shp = PPpres.Slides(MySlideArray(x)).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
shp.Shapes.PasteSpecial ppPasteEnhancedMetafile
Set mySlide = PPapp.ActiveWindow.Selection.ShapeRange
mySlide.Left = 30
mySlide.Top = 85
mySlide.Height = 150
mySlide.Width = 900
Next x
End Sub
I think this is what you want.
Option Explicit
Sub Test()
Dim lastrow As Long
Dim row1 As Long
Dim row2 As Long
Dim dataRange As Range
With Sheets("Template")
' Get last row on sheet
lastrow = .Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).row
' Copy data 15 rows at a time
row1 = 1
Do While row1 < lastrow
row2 = row1 + 14
If row2 > lastrow Then
row2 = lastrow
End If
' Copy data range
.Range("B" & row1 & ":K" & row2).Copy
'*********************************
'* Paste data to PowerPoint here *
'*********************************
row1 = row2 + 1
Loop
End With
End Sub
P.S. You might want to read this How to avoid using Select in Excel VBA
I have written the code and it is updating data in chartdata of ppt but entire range from external excel file is not being displayed when chart is produced.
So from code is pulling data from excel and pasting in chartdata of ppt but when chart is produced is shows only range a1:b4 whereas actual range is a1 : c4
Sub openppt()
Dim DestinationPPT As String
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim cht As PowerPoint.Chart
Dim chtData As PowerPoint.ChartData
Dim startcell As Range
Dim lastrow As Long
Dim lastcol As Long
Dim ws As Worksheet
Set PowerPointApp = CreateObject("PowerPoint.Application")
PowerPointApp.Visible = True
DestinationPPT = "C:\Users\alex.samuel\Desktop\assignment\VBA Training.pptx"
PowerPointApp.Presentations.Open (DestinationPPT)
Set myPresentation = PowerPointApp.Presentations("VBA Training.pptx")
'Assume we have only one slide, at slide 1:
Set sld = myPresentation.Slides(1)
'Assume the Chart is the second shape, modify if needed
Set shp = sld.Shapes("Chart 29")
'Handle the chart
Set cht = shp.Chart
'Handle the CharttData
Set chtData = cht.ChartData
'Set Object
Set ws = Sheet1
Set startcell = Range("a1")
'Find last row and column in data
lastrow = ws.Cells(ws.Rows.Count, startcell.Column).End(xlUp).Row
lastcol = ws.Cells(startcell.Row, ws.Columns.Count).End(xlToLeft).Column
'select dynamic range of data
ws.Range(startcell, ws.Cells(lastrow, lastcol)).Select
'copy dynamic range
ws.Range(startcell, ws.Cells(lastrow, lastcol)).Copy
'Open & minimize the ChartData, you don't need to see it, but it must be OPEN to edit it
chtData.Activate
ActiveSheet.Range("a1").Select
ActiveSheet.Paste
ActiveSheet.setdatasource Source:=ws.Range("a1:c4")`enter code here`
End Sub
I am trying to open a excel file, take the ranges as picture and create a ppt our of it. I am not sure what is going wrong in the code below. Can someone help please? The code works well for all other slides coming from other excel file. The moment I opena excel file and switch , it is throwing "subscript out of range error"
Sub GlobalBankPPT()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape
Dim ppPic As Variant
Dim j As Integer
Dim wkb As Workbook
Dim sh As Worksheet
Dim WS_Count As Integer, i As Integer
Dim mypp As New ExcelToPPt.cPPt
mypp.InitFromTemplate MyTemplateppt:=mytemp, MyOutputppt:=""
Set ppApp = GetObject(, "PowerPoint.Application")
ppApp.Visible = msoTrue
Set ppPres = ppApp.ActivePresentation
Set wkb = Workbooks.Open(Filename:=ThisWorkbook.Worksheets("Index").Range ("FilePath"))
wkb.Activate
WS_Count = wkb.Worksheets.Count
For i = 1 To WS_Count
If Worksheets(i).Name = "Industry" Then
wkb.Activate
Set sh = ActiveSheet
Exit For
End If
Next I
'--------------------------------------------------------------------Slide7
Range(Sheet15.Range("A150"), Sheet15.Range("Q191")).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ppPres.Slides(7).Select
Set ppPic = ppPres.Slides(7).Shapes.Paste
ppPic.Select
ppPic.Top = 70.24
ppPic.Width = 10.5 * 100
ppPic.Height = ppPic.Width / 3.4
ppPic.Left = 50
end sub
I wanted to open ppt form SharePoint using the VBA, using the command button
if any one knows please help me.
Thanks...
I have similar code...below.. but its giving me the error
Dim PPT As PowerPoint.Application
Dim fileName As Variant
Dim WS1 As Worksheet
Dim rng As Range
Set WS1 = ThisWorkbook.Worksheets("Sheet4")
Set rng = WS1.Range("AA4")
Set PPT = New PowerPoint.Application
fileName = rng
PPT.Visible = True
'PPT.Presentations.Open fileName:="F:\Reports\" & Business_Plan.Value & ".ppt"
PPT.Presentations.Open fileName("AA4")
Assuming the value of "A2" in Sheet 1 is the entire Path+File Name (F:\Reports\FileName.ppt)
Sub openPowerP()
Dim PPT As PowerPoint.Application
Dim fileName As String
Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Sheets("Sheet1")
fileName = WS1.Range("A2").Value
Set PPT = New PowerPoint.Application
PPT.Presentations.Open fileName
End Sub
The reference to powerpoint is needed of course.
I want to build a macro that connects our Excel-Data-Sheet with our Reporting-Powerpoint-Presentation.
So I have this named Range ("A") selected and copied.
Then I want to paste the data into a shape in Powerpoint which has the same name as my Range ("A").
Sub SyncWithPPT()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Set pptApp = New PowerPoint.Application
pptApp.Visible = msoTrue
Set pptPres = pptApp.presentations.Open("workingPath")
ActiveWorkbook.Names("A").RefersToRange.Select
Selection.Copy
Set pptShape = pptPres.Slides("anySlide").Shapes("A")
pptShape.Table.cell(1, 1).Shape.TextFrame.TextRange.Paste 'Here it won't paste correctly
End Sub
Everything works just fine, except the pasting. When I paste the selection everything is pasted into cell(1, 1).But I want to copy each cell into a different cell. Like it does when you paste with STRG + V.
Any help would be really appreciated.
This worked for me (Office 2007)...
Sub Tester()
Dim ppt, sld
'presentation is already open...
Set ppt = GetObject(, "powerpoint.application")
Set sld = ppt.activepresentation.slides(1)
ActiveSheet.Range("A1:B2").Copy
sld.Shapes(1).Table.Cell(1, 1).Select
ppt.ActiveWindow.View.Paste
Set sld = Nothing
Set ppt = Nothing
End Sub
'this is how to extract each cell information
'assuming that ppt communication is already done.
Dim n As Integer, j As Integer
Dim ultimaFila As Long
j = 1 'columna
ultimaFila = Range("A65536").End(xlUp).Row
For n = 1 To ultimaFila
pptShape.Table.cell(n, j).Value = Application.Workbooks("Book1").Worksheets("Sheet1").Cells(n, j).Value
Next n
End Sub