My company uses a PowerPoint presentation that has linked Excel charts (namely, linked binary worksheet objects). Each month, the name of the workbook changes (from Feb to Mar, for instance) and the name of the folder the sheet is saved in changes as well. There are 40 links to update.
Does anyone know of a VBA script/macro to batch update the name of the links in PowerPoint? Currently, each link has to be updated individually.
When I run a script, nothing happens and no links update. The PowerPoint is macro-enabled.
I've tried a few different scripts, such as:
Sub switch()
Dim osld As Slide
Dim oshp As Shape
Dim oldPath As String
Dim newPath As String
Dim strLink As String
oldPath = "C:\Users\.xlsx\"
newPath = "C:\Users\.xlsx\"
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasChart Then
If oshp.LinkFormat.SourceFullName <> "" Then
strLink = oshp.LinkFormat.SourceFullName
oshp.LinkFormat.SourceFullName = Replace(strLink, oldPath, newPath)
Debug.Print oshp.LinkFormat.SourceFullName
oshp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
oshp.LinkFormat.Update
End If
End If
Next oshp
Next osld
End Sub
Any insight would be appreciated.
Related
I have used the below VBA to update multiple links that are in a Powerpoint to an Excel Workbook. Some of the links update whereas some do not.
Please does anyone have any suggestions why it may not be working?
Any help appreciated.
Thanks
Dim oldFilePath As String
Dim newFilePath As String
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'The old file path as a string (the text to be replaced)
oldFilePath = "N:\Finance\EXCEL\BUSINESS CENTRALS\Management accounts\April 2022 to March 2023\April 22\Management Accounts - Group April 22 - V8 - BRP TEST.xlsx"
'The new file path as a string (the text to replace with)
newFilePath = "N:\Finance\EXCEL\BUSINESS CENTRALS\Management accounts\April 2022 to March 2023\April 22\Management Accounts - Group April 22 - V8 - BRP.xlsx"
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedPicture Or pptShape.Type _
= msoLinkedOLEObject Or pptShape.Type = msoLinkedChart Then
'Use Replace to change the oldFilePath to the newFilePath
pptShape.LinkFormat.SourceFullName = Replace(LCase _
(pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)
End If
Next
Next
'Update the links
pptPresentation.UpdateLinks
End Sub```
I'm trying to write a macro that takes information from an Excel sheet and opens and fills in a pre-existing Word Email Template. I wanted the information from each sheet to go into a specified section of this document and each row to fill in portions of a sentence. I was able to do this successfully by implementing a find and replace that loops for each row of the excel document.
However the hyperlinks only come through as text and from my understanding can't be stored as an object and then used to replace text, like the string content of cells. Subsequently, I've tried to use the Hyperlinks.Add function and my code successfully brings the hyperlinks form each row into the document, but I'm unable to control where in the document their placed. From my understanding this might be due to the expression before the Hyperlinks.Add and whats in the anchor.
The goal is to have the information come through in a row by row basis with the hyperlinks included. Ie.
Contents of Cell(A1) "Manual text" Hyperlink from Cell(B1)
Contents of Cell(A2) "Manual text" Hyperlink from Cell(B2)...etc
I'm new to VBA so apologies in advance for any redundancies or clunkiness, any tips would be a great help.
Option Explicit
Sub CreateWordDocuments()
Dim CustRow1, CustCol1, LastRow1, TagName1, TagValue1 As String
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim WordApp As Word.Application: Set WordApp = New
Word.Application
Dim WordDoc As Word.Document
Dim WordContent As Word.Range
Dim WordTempLoc As FileDialog
Set WordTempLoc = Application.FileDialog(msoFileDialogFilePicker)
With WordTempLoc
.Title = "Select Word file to attach"
.Filters.Add "Word Type Files", "*.docx,*.doc", 1
If .Show <> -1 Then GoTo NoSelection
DocLoc = .SelectedItems(1)
End With
NoSelection:
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc,
ReadOnly:=False) 'Open Template
Dim linkText As String
Dim link As String
LastRow1 = Worksheets("pipeline.gs.closed-or-
cancelle").Range("F9999").End(xlUp).Row
TagName1 = "PIPELINECLOSED" 'Tag Name
For CustRow1 = 2 To LastRow1
linkText = Worksheets("pipeline.gs.closed-or-
cancelle").Cells(CustRow1, "J")
link = Worksheets("pipeline.gs.closed-or-
cancelle").Cells(CustRow1, "O")
TagValue1 = Worksheets("pipeline.gs.closed-or-
cancelle").Cells(CustRow1, "G") & " Manual Text"
With WordApp.Selection.Find
.Execute FindText:=TagName1
Highlighted Code Below
WordDoc.Hyperlinks.Add Anchor:=WordApp.Selection.Range,
Address:=link, SubAddress:="", ScreenTip:="", TextToDisplay:=linkText
^^
End With
End Sub
I wrote some code to look for external links to "file A" and replace them with links to "file B". The code is in PowerPoint, "file A" and "file B" are both excel files. The PowerPoint file has about 25 "objects" linked to excel (the objects are primarily just cells from excel pasted into PowerPoint as linked objects).
The code works, but it takes 7-8 minutes to run. Any idea why it takes so long or how to make it faster? It seems as all it's doing is finding and replacing text, so I'm confused as to why it takes so much time.
Relevant portion of code:
Dim newPath As String
Dim templateHome As String
Dim oshp As Shape
Dim osld As Slide
Dim vizFile As Workbook
Dim vizFname As String
Dim replacethis As String
Dim replacewith As String
'3. Update links:
'(Replace links to template file link with links to new copy of the file)
replacethis = templateHome & vizFname
replacewith = newPath & "\" & vizFname
On Error Resume Next
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
oshp.LinkFormat.SourceFullName = Replace(oshp.LinkFormat.SourceFullName, replacethis, replacewith)
oshp.LinkFormat.Update
Next oshp
Next osld
This code is pretty clean, so there's probably not a lot you can do to optimize it, but I would caution you that it's doing more than just "finding and replacing text" :) Each call to UpdateLink retrieves data from some external source. That's not just simple string replacement!
Firstly: On Error Resume Next is swallowing a lot of errors (i.e., any shape that isn't a linked object, so, most of them), that's potentially increasing your runtime and might be better if you code around those errors rather than just eating them with Resume Next.
' On Error Resume Next ' ## Comment or remove this line :)
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
oshp.LinkFormat.SourceFullName = Replace(oshp.LinkFormat.SourceFullName, replacethis, replacewith)
oshp.LinkFormat.Update
End If
Next
Next
Also, you're calling on the oshp.LinkFormat.Update repeatedly. It is probably better to do all your text replacing in the loop, but instead of updating individual links, update them all at once outside of the loop using the Presentation.UpdateLinks method:
' On Error Resume Next ' ## Comment or remove this line :)
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
oshp.LinkFormat.SourceFullName = Replace(oshp.LinkFormat.SourceFullName, replacethis, replacewith)
' ## REMOVE oshp.LinkFormat.Update
End If
Next
Next
' Now, update the entire presentation:
ActivePresentation.UpdateLinks
I have a macro code named "KillSpecificSlide" for power point. This codes is run behind ppt.If I want to copy the same code to some another ppt or if I want to run the code from One PPT to some other different PPTs then How to do this?
My code is given below:
Sub KillSpecificSlide()
Dim oSld As Slide
Dim oShp As Shape
Dim L As Long
For L = ActivePresentation.Slides.Count To 1 Step -1
Set oSld = ActivePresentation.Slides(L)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Select Case UCase(oShp.TextFrame.TextRange)
Case Is = "Q4", "CJ"
oSld.Delete
Case Else
'not found
End Select
End If
Next oShp
Next L
End Sub
This is saved in Module 1 of a PPT named BOX.pptm..I want to run the same code for other ppt files by browsing it.
Sub PPTTest()
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Presentations.Open "D:\Us\70\Desktop\Shaon\BOD.pptx", , , False
' Note that the file name and the module
' name are required to path the macro correctly.
PPT.Run "BOD.pptx!Module1.KillSpecificSlide"
End Sub
Option Explicit
Sub listOpenPresentations()
Dim myPpt As Presentation
Debug.Print "Open ppt's : "; Application.Presentations.Count & vbCrLf
For Each myPpt In Application.Presentations
Debug.Print myPpt.Name
Call Add_and_Delete_Slide(myPpt)
Next myPpt
End Sub
Sub Add_and_Delete_Slide(locPPT As Presentation)
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Dim actWindow As Variant
For Each actWindow In Windows
If actWindow.Caption = locPPT.Name Then actWindow.Activate
Next actWindow
Set pptLayout = ActivePresentation.Slides(1).CustomLayout
Set pptSlide = ActivePresentation.Slides.AddSlide(2, pptLayout)
MsgBox "Slide 2 added in """ & ActivePresentation.Name & """"
ActivePresentation.Slides(2).Delete
MsgBox "Slide 2 deleted in """ & ActivePresentation.Name & """"
End Sub
background
I am running code (from PowerPoint) that:
Loops through every slide in a presentation.
Checks each shape to determine if it is a chart.
If it is a chart, activate the underlying Excel worksheet, and then change the links in this underlying file to a new source.
I note that the links to excel do not exist at the overall PPT level [viaInfo], they are deliberately linked to each chart so that the presentation can be edited without access to the source excel file.
The code works - broadly.
There is an ongoing error (code running fine now) that I think goes to network and memory stability (fails after around 15 charts), and I am looking to turn off screenupdating as per Turn off screenupdating for Powerpoint.
question
All the charts I access are linked to other workbooks. Yet when the Excel workbook is exposed to PowerPoint the Linksources are not shown in the Locals window even though the code processes each link (image below shows the link exists)
I flipped the automation to access the PowerPoint pack from Excel, same result. No Linksources.
Why would the full object model not also be available in the Locals window when automating PowerPoint with Excel?
Is this a localised glitch I have stumbled over, or is it a broader issue?
The picture below shows the code itearying over the links (ppl variable, but the xlWB variable has no Linksources).
code
Sub FastUpdate()
Dim sld As Slide
Dim shp As Shape
Dim pptchrt As Chart
Dim pptChrtData As ChartData
Dim xlWB As Excel.Workbook
Dim lngStart As Long
Dim strNew As String
Dim strMsg As String
Dim ppl As Variant
On Error GoTo cleanup
'set start position manually
'lngStart = 34
If lngStart = 0 Then lngStart = 1
'call custom function for user to pick file
'strNew = Getfile
strNew = "S:\Corporate Model\05 RSM submissions\05 May 2016\02 Checked RSMs\VFAT\Australia\Australia - Valuation and Financial Analysis template.xlsx"
For Each sld In ActivePresentation.Slides
If sld.SlideIndex >= lngStart Then
For Each shp In sld.Shapes
If shp.HasChart Then
Set pptchart = shp.Chart
Set pptChrtData = pptchart.ChartData
'open underlying excel file - doesn't just activate chart
pptChrtData.Activate
'
Set xlWB = pptChrtData.Workbook
'loop through all links
For Each ppl In xlWB.LinkSources
strMsg = strMsg & SlideNumber & " " & pptchart.Name & vbNewLine
xlWB.ChangeLink ppl, strNew
Next
xlWB.Close True
Set xlWB = Nothing
End If
Next shp
End If
Next sld
cleanup:
Set xlWB = Nothing
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical
If Len(strMsg) > 0 Then MsgBox strMsg, vbOKOnly, "Completed"
End Sub
Locals and Watch windows show properties of objects. List of properties of Workbook object can be found here.
LinkSources is a method with optional Type parameter.
If you want to debug LinkSources you can add it to Watch window:
or save return value to local variant variable to see it in Locals window.