asked on

PowerPoint 2007 Macro VBA to place text box

Hi,

I would like a PowerPoint 2007 macro that does the following:

1. Brings up an input box that says "enter project #"
2. Creates a small text box, with size 7 white font, in the lower right-hand corner of every slide with the value entered into the input box.

I know "small" text box and "lower right-hand corner" are vague instructions, but if there is a comment in the code to indicate where I can change the values to adjust text box size and position and can make it just right.

Also, is there a way to have this macro available for any presentation that I open?

I hope someone might know how to do this! Thanks hugely, in advance!

Andrey

jostrander

Please try this out:

Sub AddProjectNumber()
    '1) Brings up an input box that says "enter project #"
    '2) Creates a small text box, with size 7 white font, in the lower right-hand corner of every slide with the value entered into the input box.
    
    Dim objSlide As Slide
    
    '---------------------------------------------
    '   User Variables
    '---------------------------------------------
    intFontSize = 7
    intTextBoxWidth = 100
    intTextBoxHeight = 50
    strFontName = "Verdana"
    intFontColor = vbWhite
    '---------------------------------------------
    
    strProjectNumber = InputBox("enter project #", "Project Number")
    If strProjectNumber = "" Then Exit Sub
    
    ' Get the slide height and width.
    intSlideHeight = ActivePresentation.PageSetup.SlideHeight
    intSlideWidth = ActivePresentation.PageSetup.SlideWidth
    
    For Each objSlide In ActivePresentation.Slides
        With objSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, intSlideWidth - intTextBoxWidth, intSlideHeight - intTextBoxHeight, intTextBoxWidth, intTextBoxHeight)
            .TextFrame.WordWrap = msoFalse
                With .TextFrame.TextRange
                    .Text = strProjectNumber
                    With .Font
                        .Name = strFontName
                        .Size = intFontSize
                        .Color = intFontColor
                    End With
                End With
        End With
    Next
        
End Sub

Open in new window

andreyman3d2k

ASKER

Hi, awesome -- this is very close to what I am looking for!

An issue --

1. It places the textbox not all the way in the corner but closer to the middle. (I am not sure why this is happening because, it seems that logically it should end up just in the corner by the logic of the code. I attached a screenshot of what happens.

Thanks again,

Andrey
pptslideexample.bmp

ASKER CERTIFIED SOLUTION

jostrander

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

andreyman3d2k

ASKER

SUPER COOL!!! thanks!

a quick question -- is it possible for this macro to 'live in my PowerPoint', so to speak, so I can use it on any presentation?

Andrey

jostrander

Yes, I'll try to upload an Add-In here...

AddProjectNumber-rename-to-ppa.txt

andreyman3d2k

ASKER

Wow. Amazing. How did you do that? (You don't have answer that)
Can I access/change the code in the macro now?

Andrey

jostrander

Here is the full code for creating the Add-In.

In the Visual Basic editor, paste it and run Debug-->Compile VBA Project.

In PPT 2007, Save the presentation as Other Formats --> PowerPoint Add-In (or PowerPoint Add-In 97/2003)

Glad it's working for you, feel free to ask more questions if needed :)

Joe

Sub AddProjectNumber()
    '1) Brings up an input box that says "enter project #"
    '2) Creates a small text box, with size 7 white font, in the lower right-hand corner of every slide with the value entered into the input box.
    
    Dim objSlide As Slide
    
    '---------------------------------------------
    '   User Variables
    '---------------------------------------------
    intFontSize = 7
    strFontName = "Verdana"
    intFontColor = vbWhite
    
    'This is for minor adjustment of textbox position
    intMargin = 5
    '---------------------------------------------
    

    strProjectNumber = InputBox("enter project #", "Project Number")
    If strProjectNumber = "" Then Exit Sub
    
          
    ' Get the slide height and width.
    intSlideHeight = ActivePresentation.PageSetup.SlideHeight
    intSlideWidth = ActivePresentation.PageSetup.SlideWidth
    
    For Each objSlide In ActivePresentation.Slides
    
        With objSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 100)
            .Name = "MyTextBox"
            .TextFrame.WordWrap = msoFalse
            With .TextFrame.TextRange
                .Text = strProjectNumber
                With .Font
                    .Name = strFontName
                    .Size = intFontSize
                    .Color = intFontColor
                End With
                intTextBoxWidth = .BoundWidth
                intTextBoxHeight = .BoundHeight
            End With
            .Left = intSlideWidth - intTextBoxWidth - intMargin
            .Top = intSlideHeight - intTextBoxHeight - intMargin
        End With
        
    Next
    
        
End Sub


   Sub Auto_Open()

      Dim NewControl As CommandBarControl

      ' Store an object reference to a command bar.
      Dim ToolsMenu As CommandBars

      ' Figure out where to place the menu choice.
      Set ToolsMenu = Application.CommandBars

      ' Create the menu choice. The choice is created in the first
      ' position in the Tools menu.
      Set NewControl = ToolsMenu("Tools").Controls.Add _
                       (Type:=msoControlButton, _
                        Before:=1)

      ' Name the command.
      NewControl.Caption = "Add Project Number"

      ' Connect the menu choice to your macro. The OnAction property
      ' should be set to the name of your macro.
      NewControl.OnAction = "AddProjectNumber"

   End Sub
   
   
      Sub Auto_Close()

      Dim oControl As CommandBarControl
      Dim ToolsMenu As CommandBars

      ' Get an object reference to a command bar.
      Set ToolsMenu = Application.CommandBars

      ' Loop through the commands on the tools menu.
      For Each oControl In ToolsMenu("Tools").Controls

            ' Check to see whether the comand exists.
            If oControl.Caption = "Add Project Number" Then

              ' Check to see whether action setting is set to ChangeView.
              If oControl.OnAction = "AddProjectNumber" Then

                  ' Remove the command from the menu.
                  oControl.Delete
               End If
            End If
      Next oControl

   End Sub

Open in new window

andreyman3d2k

ASKER

Amazing. Thanks so much. Just learned a ton here. So there is no equivalent of 'personal macro workbook' for Powerpoint like there is in Excel, huh?

I do have one other question, if you don't mind -- how would you make a conditional statement in your code to say
"if this is the first slide, do code 1, otherwise, do code 2"

( I just realized that for the title slide, I would need it to have black font, because it has a white background there : ) -- I am pretty sure I can change the code, just not sure about the syntax for determining what slide is selected.) My plan is to have the conditional after the line:

For Each objSlide In ActivePresentation.Slides

which will say "if this is slide 1 then [your code with black font] else [your code with white font]" is this the best way?

Andrey

jostrander

I don't know of any other way to add the function to every slide other than making an add-in.

BTW, This was fun for me too and I learned a lot as well, thanks!

Here's an example that will change the color to black for SlideIndex=1

Sub AddProjectNumber()
    '1) Brings up an input box that says "enter project #"
    '2) Creates a small text box, with size 7 white font, in the lower right-hand corner of every slide with the value entered into the input box.
    
    Dim objSlide As Slide
    
    '---------------------------------------------
    '   User Variables
    '---------------------------------------------
    intFontSize = 7
    strFontName = "Verdana"
    intFontColor = vbWhite
    intFontColorTitle = vbBlack

    'This is for minor adjustment of textbox position
    intMargin = 5
    '---------------------------------------------
    

    strProjectNumber = InputBox("enter project #", "Project Number")
    If strProjectNumber = "" Then Exit Sub
    
          
    ' Get the slide height and width.
    intSlideHeight = ActivePresentation.PageSetup.SlideHeight
    intSlideWidth = ActivePresentation.PageSetup.SlideWidth
    
    For Each objSlide In ActivePresentation.Slides
       
        With objSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 100)
            .Name = "MyTextBox"
            .TextFrame.WordWrap = msoFalse
            With .TextFrame.TextRange
                .Text = strProjectNumber
                With .Font
                    .Name = strFontName
                    .Size = intFontSize
                    If objSlide.SlideIndex = 1 Then
                        .Color = intFontColorTitle
                    Else
                        .Color = intFontColor
                    End If
                    
                End With
                intTextBoxWidth = .BoundWidth
                intTextBoxHeight = .BoundHeight
            End With
            .Left = intSlideWidth - intTextBoxWidth - intMargin
            .Top = intSlideHeight - intTextBoxHeight - intMargin
        End With
        
    Next
    
        
End Sub

Open in new window

andreyman3d2k

ASKER

Hey, that's awesome! Thanks for the help. I actually have another question related to this, and I posted it separately -- here:

https://www.experts-exchange.com/questions/25646588/PowerPoint-2007-Macro-VBA-to-delete-text-box.html

You would probably be the most qualified to answer it, if you are interested, because it relates to this macro. Basically the folks at my company like to recycle slides from prior presentations, so I would like the macro you made to first delete any project number text box that already may be there. They are always all the way in the corner. Not sure if this is possible, but thought I might ask..

Andrey