Hi Everyone,
This is my first post and I hope you can help me.
I've been stuck with this for a while now.
In bold is where the code breaks and I don't know how to fix it. Can anyone help?
Here's the code
Sub CreatePowerPoint()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
'Add a reference to the Microsoft PowerPoint Library by:<o></o>
'1. Go to Tools in the VBA menu<o></o>
'2. Click on Reference<o></o>
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay<o></o>
<o></o>
'First we declare the variables we will be using<o></o>
Dim pptx As PowerPoint.Application<o></o>
Dim activeSlide As Slide<o></o>
Dim cht As Excel.ChartObject<o></o>
<o></o>
'Look for existing instance<o></o>
On Error Resume Next<o></o>
Set pptx = GetObject(, "PowerPoint.Application")<o></o>
On Error GoTo 0<o></o>
<o></o>
'Let's create a new PowerPoint<o></o>
<o></o>
Set pptx = New PowerPoint.Application<o></o>
pptx.Visible = msoCTrue<o></o>
<o></o>
pptx.Presentations.Open Filename:="……………………<o></o>
<o></o>
'Show the PowerPoint & save as the current selection on excel into the outputs folder<o></o>
pptx.Visible = True<o></o>
<o></o>
a = Format(Sheets("Tables").Range("D2").Value, "mmm-yy")<o></o>
<o></o>
b = Sheets("Tables").Range("D4").Value<o></o>
<o></o>
c = Format(Date, "yymmdd")<o></o>
<o></o>
pptx.ActivePresentation.SaveAs Filename:="……………………….. <o></o>
<o></o>
Dim oShp As Shape<o></o>
Dim oTxtRng As TextRange<o></o>
Dim oTmpRng As TextRange<o></o>
Dim strWhatReplace As String, strReplaceText As String<o></o>
<o></o>
' write find text<o></o>
strWhatReplace = "Member"<o></o>
' write change text<o></o>
strReplaceText = "b"<o></o>
<o></o>
' go during each slides<o></o>
For Each activeSlide In pptx.ActivePresentation.Slides<o></o>
' go during each shapes and textRanges<o></o>
For Each oShp In activeSlide.Shapes "it triggers an error 13, type mismatch"
' replace in TextFrame<o></o>
Set oTxtRng = oShp.TextFrame.TextRange<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
<o></o>
Do While Not oTmpRng Is Nothing<o></o>
<o></o>
Set oTxtRng = oTxtRng.Characters _<o></o>
(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
Loop<o></o>
Next oShp<o></o>
Next activeSlide<o></o>
This is my first post and I hope you can help me.
I've been stuck with this for a while now.
In bold is where the code breaks and I don't know how to fix it. Can anyone help?
Here's the code
Sub CreatePowerPoint()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
'Add a reference to the Microsoft PowerPoint Library by:<o></o>
'1. Go to Tools in the VBA menu<o></o>
'2. Click on Reference<o></o>
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay<o></o>
<o></o>
'First we declare the variables we will be using<o></o>
Dim pptx As PowerPoint.Application<o></o>
Dim activeSlide As Slide<o></o>
Dim cht As Excel.ChartObject<o></o>
<o></o>
'Look for existing instance<o></o>
On Error Resume Next<o></o>
Set pptx = GetObject(, "PowerPoint.Application")<o></o>
On Error GoTo 0<o></o>
<o></o>
'Let's create a new PowerPoint<o></o>
<o></o>
Set pptx = New PowerPoint.Application<o></o>
pptx.Visible = msoCTrue<o></o>
<o></o>
pptx.Presentations.Open Filename:="……………………<o></o>
<o></o>
'Show the PowerPoint & save as the current selection on excel into the outputs folder<o></o>
pptx.Visible = True<o></o>
<o></o>
a = Format(Sheets("Tables").Range("D2").Value, "mmm-yy")<o></o>
<o></o>
b = Sheets("Tables").Range("D4").Value<o></o>
<o></o>
c = Format(Date, "yymmdd")<o></o>
<o></o>
pptx.ActivePresentation.SaveAs Filename:="……………………….. <o></o>
<o></o>
Dim oShp As Shape<o></o>
Dim oTxtRng As TextRange<o></o>
Dim oTmpRng As TextRange<o></o>
Dim strWhatReplace As String, strReplaceText As String<o></o>
<o></o>
' write find text<o></o>
strWhatReplace = "Member"<o></o>
' write change text<o></o>
strReplaceText = "b"<o></o>
<o></o>
' go during each slides<o></o>
For Each activeSlide In pptx.ActivePresentation.Slides<o></o>
' go during each shapes and textRanges<o></o>
For Each oShp In activeSlide.Shapes "it triggers an error 13, type mismatch"
' replace in TextFrame<o></o>
Set oTxtRng = oShp.TextFrame.TextRange<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
<o></o>
Do While Not oTmpRng Is Nothing<o></o>
<o></o>
Set oTxtRng = oTxtRng.Characters _<o></o>
(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
Loop<o></o>
Next oShp<o></o>
Next activeSlide<o></o>