power point name replacement

termeric

Active Member
Joined
Jun 21, 2005
Messages
280
i have a powerpoint presentation with about 100 slides. ive got a macro/ user form where i can check off boxes and then when im ready, it will delete the sections that are unchecked. i would like to add to this form a way to change the name of who the presentation is being presented to. currently, i just do a find / replace on "ABC Company".

how can i automate this process, so i can just type into the user form the company name, and durring the finalizing, it'll search the presentation and change the name.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Try this code.

Code:
Sub ChangeTheName()
  Dim s As Slide
  Dim oShp As Shape
  Dim oTxtRng As TextRange
  Dim oTmpRng As TextRange
  Dim oInp1 As String
  Dim oInp2 As String
  With ActivePresentation
    
   oInp1 = InputBox("Old Name", "Change Company")
   oInpt2 = InputBox("New Name", "Change Company")
    For Each s In .Slides
        
   For Each oShp In s.Shapes
        Set oTxtRng = oShp.TextFrame.TextRange
        Set oTmpRng = oTxtRng.Replace(FindWhat:=oInp1, _
            Replacewhat:=oInpt2, WholeWords:=True)
        Do While Not oTmpRng Is Nothing
            Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _
                oTxtRng.Length)
            Set oTmpRng = oTxtRng.Replace(FindWhat:=oInp1, _
                Replacewhat:=oInpt2, WholeWords:=True)
        Loop
        
    Next oShp
   
   
    Next s
  End With
End Sub
 
Upvote 0
Here's one from a UserForm

Code:
Sub ChangeTheName()
  Dim s As Slide
  Dim oShp As Shape
  Dim oTxtRng As TextRange
  Dim oTmpRng As TextRange
  Dim Inp3 As String
  Dim Inp4 As String
  With ActivePresentation

   
    Inp3 = ChangeCompanyForm.textboxInp3
    Inp4 = ChangeCompanyForm.textboxInp4
    For Each s In .Slides
        
   For Each oShp In s.Shapes
        Set oTxtRng = oShp.TextFrame.TextRange
        Set oTmpRng = oTxtRng.Replace(FindWhat:=Inp3, _
            Replacewhat:=Inp4, WholeWords:=True)
        Do While Not oTmpRng Is Nothing
            Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _
                oTxtRng.Length)
            Set oTmpRng = oTxtRng.Replace(FindWhat:=Inp3, _
                Replacewhat:=Inp4, WholeWords:=True)
        Loop
        
    Next oShp
   
   
    Next s
  End With
End Sub
 
Upvote 0
Set oTxtRng = oShp.TextFrame.TextRange

i've been using the first code, with the pop up promts.

this code works when i make a new worksheet, and use a few dummy slides, but when i add it to my existing slide deck, it bugs out.
 
Upvote 0
Module 1

Code:
Sub Create_Presentation()
Load UserForm1
UserForm1.Show

End Sub

Userform1 - i dont have a way to post a picture of this form, but its a few check boxes so i can select slides i want to keep and then a button to run the code
Code:
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox1 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox10_Click()
If CheckBox10 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox10 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox11_Click()
If CheckBox11 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox11 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox12_Click()
If CheckBox12 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox12 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox13_Click()
If CheckBox13 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox13 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox14_Click()
If CheckBox14 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox14 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox15_Click()
If CheckBox15 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox15 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox16_Click()
If CheckBox16 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox16 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox17_Click()
If CheckBox17 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox17 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox18_Click()
If CheckBox18 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox18 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox19_Click()
If CheckBox19 = True Then
Label5.Caption = Label5.Caption + 3
End If
If CheckBox19 = False Then
Label5.Caption = Label5.Caption - 3
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2 = True Then
Label5.Caption = Label5.Caption + 7
End If
If CheckBox2 = False Then
Label5.Caption = Label5.Caption - 7
End If
End Sub

Private Sub CheckBox20_Click()
If CheckBox20 = True Then
Label5.Caption = Label5.Caption + 2
End If
If CheckBox20 = False Then
Label5.Caption = Label5.Caption - 2
End If
End Sub

Private Sub CheckBox21_Click()
If CheckBox21 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox21 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox22_Click()
If CheckBox22 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox22 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox23_Click()
If CheckBox23 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox23 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox24_Click()
If CheckBox24 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox24 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox25_Click()
If CheckBox25 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox25 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox3_Click()
If CheckBox3 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox3 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox4_Click()
If CheckBox4 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox4 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox5_Click()
If CheckBox5 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox5 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox6_Click()
If CheckBox6 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox6 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox7_Click()
If CheckBox7 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox7 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox8_Click()
If CheckBox8 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox8 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CheckBox9_Click()
If CheckBox9 = True Then
Label5.Caption = Label5.Caption + 1
End If
If CheckBox9 = False Then
Label5.Caption = Label5.Caption - 1
End If
End Sub

Private Sub CommandButton1_Click()
'Application.Run "Slide1to2"
ChangeTheName
Call Slide1to2
End Sub

Private Sub Slide1to2()

Dim slide1 As Integer
Dim slide2 As Integer
Dim slide3 As Integer
Dim slide4 As Integer
Dim slide5 As Integer
Dim slide6 As Integer
Dim slide7 As Integer
Dim slide8 As Integer
Dim slide9 As Integer
Dim slide10 As Integer
Dim slide11 As Integer
Dim slide12 As Integer
Dim slide13 As Integer
Dim slide14 As Integer
Dim slide15 As Integer
Dim slide16 As Integer
Dim slide17 As Integer
Dim slide18 As Integer
Dim slide19 As Integer
Dim slide20 As Integer
Dim slide21 As Integer
Dim slide22 As Integer
Dim slide23 As Integer
Dim slide24 As Integer
Dim slide25 As Integer
Dim slide26 As Integer
Dim slide27 As Integer
Dim slide28 As Integer
Dim slide29 As Integer
Dim slide30 As Integer
Dim slide31 As Integer
Dim slide32 As Integer
Dim slide33 As Integer
Dim slide34 As Integer
Dim slide35 As Integer
Dim slide36 As Integer
Dim slide37 As Integer
Dim slide38 As Integer
Dim slide39 As Integer
Dim slide40 As Integer
Dim slide41 As Integer
Dim slide42 As Integer
Dim slide43 As Integer
Dim slide44 As Integer
Dim slide45 As Integer
Dim slide46 As Integer
Dim slide47 As Integer
Dim slide48 As Integer
Dim slide49 As Integer
Dim slide50 As Integer
Dim slide51 As Integer
Dim slide52 As Integer
Dim slide53 As Integer
Dim slide54 As Integer
Dim slide55 As Integer
Dim slide56 As Integer
Dim slide57 As Integer
Dim slide58 As Integer
Dim slide59 As Integer
Dim slide60 As Integer
Dim slide61 As Integer
Dim slide62 As Integer
Dim slide63 As Integer
Dim slide64 As Integer
Dim slide65 As Integer
Dim slide66 As Integer
Dim slide67 As Integer
Dim slide68 As Integer
Dim slide69 As Integer
Dim slide70 As Integer
Dim slide71 As Integer
Dim slide72 As Integer
Dim slide73 As Integer
Dim slide74 As Integer
Dim slide75 As Integer
Dim slide76 As Integer
Dim slide77 As Integer
Dim slide78 As Integer
Dim slide79 As Integer
Dim slide80 As Integer
Dim slide81 As Integer
Dim slide82 As Integer
Dim slide83 As Integer
Dim slide84 As Integer
Dim slide85 As Integer
Dim slide86 As Integer
Dim slide87 As Integer
Dim slide88 As Integer
Dim slide89 As Integer
Dim slide90 As Integer


slide1 = 0
slide2 = 0
slide3 = 0
slide4 = 0
slide5 = 0
slide6 = 0
slide7 = 0
slide8 = 0
slide9 = 0
slide10 = 0
slide11 = 0
slide12 = 0
slide13 = 0
slide14 = 0
slide15 = 0
slide16 = 0
slide17 = 0
slide18 = 0
slide19 = 0
slide20 = 0
slide21 = 0
slide22 = 0
slide23 = 0
slide24 = 0
slide25 = 0
slide26 = 0
slide27 = 0
slide28 = 0
slide29 = 0
slide30 = 0
slide31 = 0
slide32 = 0
slide33 = 0
slide34 = 0
slide35 = 0
slide36 = 0
slide37 = 0
slide38 = 0
slide39 = 0
slide40 = 0
slide41 = 0
slide42 = 0
slide43 = 0
slide44 = 0
slide45 = 0
slide46 = 0
slide47 = 0
slide48 = 0
slide49 = 0
slide50 = 0
slide51 = 0
slide52 = 0
slide53 = 0
slide54 = 0
slide55 = 0
slide56 = 0
slide57 = 0
slide58 = 0
slide59 = 0
slide60 = 0
slide61 = 0
slide62 = 0
slide63 = 0
slide64 = 0
slide65 = 0
slide66 = 0
slide67 = 0
slide68 = 0
slide69 = 0
slide70 = 0
slide71 = 0
slide72 = 0
slide73 = 0
slide74 = 0
slide75 = 0
slide76 = 0
slide77 = 0
slide78 = 0
slide79 = 0
slide80 = 0
slide81 = 0
slide82 = 0
slide83 = 0
slide84 = 0
slide85 = 0
slide86 = 0
slide87 = 0
slide88 = 0
slide89 = 0
slide90 = 0


'Section to identify if unchecked for any reason
If UserForm1.CheckBox1.Value = False Then
slide8 = slide8 + 1
End If

If UserForm1.CheckBox2.Value = False Then
slide9 = slide9 + 1
slide10 = slide10 + 1
slide11 = slide11 + 1
slide12 = slide12 + 1
slide13 = slide13 + 1
slide14 = slide14 + 1
slide15 = slide15 + 1
End If

If UserForm1.CheckBox3.Value = False Then
slide16 = slide16 + 1
End If

If UserForm1.CheckBox4.Value = False Then
slide17 = slide17 + 1
End If

If UserForm1.CheckBox5.Value = False Then
slide18 = slide18 + 1
End If

If UserForm1.CheckBox6.Value = False Then
slide19 = slide19 + 1
End If

If UserForm1.CheckBox7.Value = False Then
slide20 = slide20 + 1
End If

If UserForm1.CheckBox8.Value = False Then
slide21 = slide21 + 1
End If

If UserForm1.CheckBox9.Value = False Then
slide22 = slide22 + 1
End If

If UserForm1.CheckBox10.Value = False Then
slide23 = slide23 + 1
End If

If UserForm1.CheckBox11.Value = False Then
slide24 = slide24 + 1
End If

If UserForm1.CheckBox12.Value = False Then
slide25 = slide25 + 1
End If

If UserForm1.CheckBox13.Value = False Then
slide26 = slide26 + 1
End If

If UserForm1.CheckBox14.Value = False Then
slide27 = slide27 + 1
End If

If UserForm1.CheckBox15.Value = False Then
slide28 = slide28 + 1
End If

If UserForm1.CheckBox16.Value = False Then
slide29 = slide29 + 1
End If

If UserForm1.CheckBox17.Value = False Then
slide30 = slide30 + 1
End If

If UserForm1.CheckBox18.Value = False Then
slide31 = slide31 + 1
End If

If UserForm1.CheckBox19.Value = False Then
slide32 = slide32 + 1
slide33 = slide33 + 1
slide34 = slide34 + 1
End If

If UserForm1.CheckBox20.Value = False Then
slide35 = slide35 + 1
slide36 = slide36 + 1
End If

If UserForm1.CheckBox21.Value = False Then
slide37 = slide37 + 1
End If

If UserForm1.CheckBox22.Value = False Then
slide38 = slide38 + 1
End If

If UserForm1.CheckBox23.Value = False Then
slide39 = slide39 + 1
End If

If UserForm1.CheckBox24.Value = False Then
slide40 = slide40 + 1
End If

If UserForm1.CheckBox25.Value = False Then
slide41 = slide41 + 1
End If



'Section to Delete slides where one or more reasons dictate removing it


If slide41 > 0 Then
ActivePresentation.Slides(41).Delete
End If

If slide40 > 0 Then
ActivePresentation.Slides(40).Delete
End If

If slide39 > 0 Then
ActivePresentation.Slides(39).Delete
End If

If slide38 > 0 Then
ActivePresentation.Slides(38).Delete
End If

If slide37 > 0 Then
ActivePresentation.Slides(37).Delete
End If

If slide36 > 0 Then
ActivePresentation.Slides(36).Delete
End If

If slide35 > 0 Then
ActivePresentation.Slides(35).Delete
End If

If slide34 > 0 Then
ActivePresentation.Slides(34).Delete
End If

If slide33 > 0 Then
ActivePresentation.Slides(33).Delete
End If

If slide32 > 0 Then
ActivePresentation.Slides(32).Delete
End If

If slide31 > 0 Then
ActivePresentation.Slides(31).Delete
End If

If slide30 > 0 Then
ActivePresentation.Slides(30).Delete
End If

If slide29 > 0 Then
ActivePresentation.Slides(29).Delete
End If

If slide28 > 0 Then
ActivePresentation.Slides(28).Delete
End If

If slide27 > 0 Then
ActivePresentation.Slides(27).Delete
End If

If slide26 > 0 Then
ActivePresentation.Slides(26).Delete
End If

If slide25 > 0 Then
ActivePresentation.Slides(25).Delete
End If

If slide24 > 0 Then
ActivePresentation.Slides(24).Delete
End If

If slide23 > 0 Then
ActivePresentation.Slides(23).Delete
End If

If slide22 > 0 Then
ActivePresentation.Slides(22).Delete
End If

If slide21 > 0 Then
ActivePresentation.Slides(21).Delete
End If

If slide20 > 0 Then
ActivePresentation.Slides(20).Delete
End If

If slide19 > 0 Then
ActivePresentation.Slides(19).Delete
End If

If slide18 > 0 Then
ActivePresentation.Slides(18).Delete
End If

If slide17 > 0 Then
ActivePresentation.Slides(17).Delete
End If

If slide16 > 0 Then
ActivePresentation.Slides(16).Delete
End If

If slide15 > 0 Then
ActivePresentation.Slides(15).Delete
End If

If slide14 > 0 Then
ActivePresentation.Slides(14).Delete
End If

If slide13 > 0 Then
ActivePresentation.Slides(13).Delete
End If

If slide12 > 0 Then
ActivePresentation.Slides(12).Delete
End If

If slide11 > 0 Then
ActivePresentation.Slides(11).Delete
End If

If slide10 > 0 Then
ActivePresentation.Slides(10).Delete
End If

If slide9 > 0 Then
ActivePresentation.Slides(9).Delete
End If

If slide8 > 0 Then
ActivePresentation.Slides(8).Delete
End If

If slide7 > 0 Then
ActivePresentation.Slides(7).Delete
End If

If slide6 > 0 Then
ActivePresentation.Slides(6).Delete
End If

If slide5 > 0 Then
ActivePresentation.Slides(5).Delete
End If

If slide4 > 0 Then
ActivePresentation.Slides(4).Delete
End If

If slide3 > 0 Then
ActivePresentation.Slides(3).Delete
End If

If slide2 > 0 Then
ActivePresentation.Slides(2).Delete
End If

If slide1 > 0 Then
ActivePresentation.Slides(1).Delete
End If


UserForm1.Hide

End Sub


Sub ChangeTheName()
  Dim s As Slide
  Dim oShp As Shape
  Dim oTxtRng As TextRange
  Dim oTmpRng As TextRange
  Dim oInp1 As String
  Dim oInp2 As String
  With ActivePresentation
    
   oInp1 = InputBox("Old Name", "Change Company")
   oInpt2 = InputBox("New Name", "Change Company")
    For Each s In .Slides
        
   For Each oShp In s.Shapes
        Set oTxtRng = oShp.TextFrame.TextRange
        Set oTmpRng = oTxtRng.Replace(FindWhat:=oInp1, _
            Replacewhat:=oInpt2, WholeWords:=True)
        Do While Not oTmpRng Is Nothing
            Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _
                oTxtRng.Length)
            Set oTmpRng = oTxtRng.Replace(FindWhat:=oInp1, _
                Replacewhat:=oInpt2, WholeWords:=True)
        Loop
        
    Next oShp
   
   
    Next s
  End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,225,360
Messages
6,184,508
Members
453,237
Latest member
lordleo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top