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.
Related
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
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'm trying to write a code to run from excel, and then open an existing excel and powerpoint file from the c drive, and use the data in the worksheet named "Oct18" to update the FIRST table in Slide 2 of the powerpoint.
The following is the code I wrote, but somehow it doesn't work.
May I know if anyone knows how to go about this please ?
Sub WriteText_toPPT_Table()
'Add a reference to Microsoft Powerpoint 12.0 object library
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppShp As PowerPoint.Shape
Dim ppSld As PowerPoint.slide
Dim xlworkbook As Workbook
Dim firstsheet As String
Dim fileDir As String
Dim excelFile As String
firstsheet = "Oct18"
'fileDir = "c:\masterpresentation.pptx"
'excelFile = "c:\masterexcel.pptx
'1) Open powerpoint application
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set xlworkbook = Excel.Application.Workbooks.Open(Filename:=excelFile)
'2) opening an existing presentation
Set ppPres = ppApp.Presentations.Open(Filename:=fileDir)
Set exceldir = Excel.Application.Workbooks.Open(Filename:=excelFile)
ppPres.Slides(2).Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = xlworkbook.Sheets(firstsheet).Cells(4, 12)
End Sub
Sub jede_Grafik_nach_PowerPoint()
'Extras - Verweise: Microsoft PowerPoint x.x Object Library
Dim Grafik As Shape
Dim PP As Object
Set PP = CreateObject("Powerpoint.Application")
Dim PP_Datei As PowerPoint.Presentation
Dim PP_Folie As PowerPoint.Slide
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set PP_Datei = PP.Presentations.Open("C:\Users\akaygun\Desktop\test.pptm")
PP.Visible = msoTrue
'Set PP_Datei = PP.ActivePresentation wenn akt. Präsi sein soll
For Each ws In wb.Sheets
If Left(ws.Name, 3) = "MLK" Then
'neue Folie einfügen
PP_Datei.Slides(3).Copy
PP_Datei.Slides.Paste
Set PP_Folie = PP_Datei.Slides(PP_Datei.Slides.Count)
'copypaste
ws.Shapes("Stunden").Copy
PP_Folie.Shapes.Paste
PP_Folie.Shapes("Stunden").Top = 315.1991
PP_Folie.Shapes("Stunden").Left = 22.17449
ws.Shapes("Tage").Copy
PP_Folie.Shapes.Paste
PP_Folie.Shapes("Tage").Top = 10.16945
PP_Folie.Shapes("Tage").Left = -2.806772
End If
Next ws
End Sub
Dear Community,
I am trying to paste diagramms from excel to Powerpoint via VBA automatically.
When running this Sub it always says : "Remote server Computer doesnt exist"
'462'
I already tried to set a New Presentation instead of an Object but it did not help.
I have built a workbook to facilitate the creation of a monthly report presentation I am in charge of. The workbook has some data sheets, some processing sheets and then numbered sheets which contain the charts I need to paste to the corresponding slide. So far, I've built the VBA for opening the PowerPoint template and looping through each excel sheet, and discriminating which sheet names are numeric, and then activating the corresponding slide on the powerpoint template.
Unlike other solutions to similar problems I've found, I'd like to copy all charts from each numbered sheet to each slide at a time, as they are different in shape, quantities and disposition for each sheet/slide. I've mostly only found people copying one chart at a time and pastying as image, which will also not work for me (I need to fine tune data labels and position on the final slide). Any hints as to how could I achieve that?
Here's what my code looks like so far:
Sub CriarSlides()
Dim pptApp As Powerpoint.Application
Dim pptPres As Powerpoint.Presentation
Dim strFileToOpen As Variant
Dim strFileName As String, Hosp As String
Dim datawb As Workbook
Dim xlsCounter As Integer, xlsSlide As Integer
Set datawb = ThisWorkbook
strFileToOpen = Application.GetOpenFilename _
FileFilter:="Powerpoint Files *.pptx (*.pptx),")
If strFileToOpen = False Then
Exit Sub
Else
Set pptApp = New Powerpoint.Application
pptApp.Visible = True
pptApp.Presentations.Open Filename:=strFileToOpen, ReadOnly:=msoFalse, Untitled:=msoTrue
Set pptPres = pptApp.Presentations(1)
End If
For xlsCounter = datawb.Worksheets.Count To 1 Step -1
If IsNumeric(datawb.Worksheets(xlsCounter).Name) Then
xlsSlide = datawb.Worksheets(xlsCounter).Name
' This is the problematic part
Debug.Print xlsSlide
End If
Next xlsCounter
End Sub
With the following modified code you can paste the chart-objects of each sheet in the corresponding slide:
Sub CriarSlides()
Dim pptApp As PowerPoint.Application, pptPres As PowerPoint.Presentation
Dim strFileToOpen As Variant, sh As Worksheet, ch As ChartObject
strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),")
If strFileToOpen = False Then Exit Sub
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open(fileName:=strFileToOpen, ReadOnly:=msoFalse)
For Each sh In ThisWorkbook.Sheets
If IsNumeric(sh.name) Then
For Each ch In sh.ChartObjects
ch.Copy
With pptPres.Slides(CLng(sh.name)).Shapes.Paste
.Top = ch.Top
.Left = ch.Left
.Width = ch.Width
.Height = ch.Height
End With
Next
End If
Next
End Sub