PDA

View Full Version : [SOLVED:] VBA Powerpoint Macros: Set String in one Macro, use it in another


Martijn6134
11-09-2016, 04:57 AM
I'm trying to create a Macro in Powerpoint so that when a list of certain items is presented, I can select a few of those and then use that information in a different macro to automatically place a picture in a Powerpoint for each item selected.
I already managed to get the second part done, so placing the pictures in the powerpoint is no problem.
My problem lays with the selecting part. The way I figured to do it is to create a macro for each item in the list so for example the list is:
- Bed
- Bug
- Bath
- Broom
In front of each item I want to place a square which when clicked upon would be ticked off and sets a string to a certain value so if you would click on the box of 'Bed' it would put a tick in that box and do:
strEquip1 = "Bed"
In the second Macro, which will only be used as soon as all items needed were selected, I want that string from the other Macro to be imported so it would only import the strings that were created by clicking those boxes in other macros.
I hope my explanation makes a bit of sense, I'm not a programmer at all and I'm doing this as a side project for myself and for fun.
Thanks in advance for the help!
John Wilson
11-09-2016, 07:33 AM
You would do better to post the exiting code. In general though

You could either declare the variable OUTSIDE of the sub

'declare outside of sub
Dim strA As String
Dim strB As String
Sub Number1()
strA = "John"
strB = "Wilson"
If MsgBox("Run Sub#2?", vbOKCancel) = vbOK Then
Call Number2
End If
End Sub


Sub Number2()
MsgBox strA & " " & strB
End Sub

OR (maybe better) pass the variables to the second sub like this:

Sub Number1()
Dim strA As String
Dim strB As String
strA = "John"
strB = "Wilson"
If MsgBox("Run Sub#2?", vbOKCancel) = vbOK Then
Call Number2(strA, strB)
End If
End Sub


Sub Number2(strA As String, strB As String)
MsgBox strA & " " & strB
End Sub
Martijn6134
11-09-2016, 08:00 AM
Hey John,

I'll post the code I have currently at the end of this message.
In general I want to find the easiest way of doing it. In total were talking of 546 items that I would have in the list which I should be able to select manually. If I want to do it the way I want to, I would need to make 546 macros and then one main macro which creates the eventual slideshow. This is gonna take me a while to create so the least amount of changes I have to make to the script each time I copy paste, the better it is :D There probably is a lot I can do more efficient in the code I have but like I said, I'm a complete noob at programming and the code I have right now is something that I made a while ago and which I am now using to create a different macro.

If you look at the code it says:
strEquip1 = "2S1"
strEquip2 = "SU27"
These I want to be set to the corresponding items which I would click on in the powerpoint. This will go op to strEquip546 eventually.

In the bottom there's a rough visualization of which I want to create. What it boils down to is that I have a powerpoint slideshow with multiple pages like this I can navigate through. I want to be able to select certain items and then click on the create button which will run the script I currently have with all those items selected in there as a strEquip.



Sub AutoReco()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim oPic2 As Shape
Dim oTxt As Shape
Dim oTxt2 As Shape
Dim oTxt3 As Shape
Dim oBoxTop As Shape
Dim oBoxBottom As Shape
Dim strEquip(1 To 2) As String

strEquip1 = "2S1"
strEquip2 = "SU27"

strPath = ActivePresentation.Path & "\MEDIA\"
strFileSpec = "*.*"
strTemp = Dir(strPath & strEquip1 & "\" & strFileSpec)

Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strEquip1 & "\" & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)
Set oBoxTop = oSld.Shapes.AddShape(msoShapeRectangle, _
Left:=0, Top:=0, Width:=720, Height:=60)
Set oBoxBottom = oSld.Shapes.AddShape(msoShapeRectangle, _
Left:=0, Top:=480, Width:=720, Height:=60)
Set oTxt = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=0, Width:=720, Height:=60)
Set oTxt2 = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=494, Width:=685, Height:=50)
Set oTxt3 = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=514, Width:=685, Height:=50)
Set oPic2 = oSld.Shapes.AddPicture(FileName:=strPath & "crest.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=680, _
Top:=485, _
Width:=-1, _
Height:=-1)

With oPic
If 3 * .Width > 4 * .Height Then
.Width = ActivePresentation.PageSetup.SlideWidth
.Top = 0.5 * (ActivePresentation.PageSetup.SlideHeight - .Height)
Else
.Height = ActivePresentation.PageSetup.SlideHeight
.Left = 0.5 * (ActivePresentation.PageSetup.SlideWidth - .Width)
End If

End With
With oBoxTop
.Fill.ForeColor.RGB = RGB(30, 123, 193)
.Line.ForeColor.RGB = RGB(30, 123, 193)
End With
With oBoxBottom
.Fill.ForeColor.RGB = RGB(30, 123, 193)
.Line.ForeColor.RGB = RGB(30, 123, 193)
End With
With oTxt
.TextFrame.TextRange.Text = strTemp
.TextEffect.FontName = "Palatino Linotype (Body)"
.TextEffect.Alignment = msoTextEffectAlignmentCentered
.TextEffect.FontSize = 43
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
'.Fill.ForeColor.RGB = RGB(30, 123, 193)
.TextFrame.TextRange.Replace Findwhat:=".jpg", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:=".png", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:=".gif", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(1)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(2)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(3)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(4)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(5)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(6)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(7)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(8)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(9)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(10)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(11)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(12)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(13)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(14)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(15)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(16)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(17)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(18)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(19)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(20)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(21)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(22)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(23)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(24)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(25)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(26)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(27)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(28)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(29)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(30)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(31)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(32)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(33)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(34)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(35)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(36)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(37)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(38)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(39)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(40)", ReplaceWhat:=""
.AnimationSettings.EntryEffect = ppEffectAppear
End With

With oTxt2
.TextFrame.TextRange.Text = "349(F)Squadron"
.TextEffect.FontName = "Palatino Linotype"
.TextEffect.Alignment = msoTextEffectAlignmentRight
.TextEffect.FontSize = 16
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.TextEffect.FontItalic = msoTrue
End With

With oTxt3
.TextFrame.TextRange.Text = "Strike Hard Strike Home"
.TextEffect.FontName = "Palatino Linotype"
.TextEffect.Alignment = msoTextEffectAlignmentRight
.TextEffect.FontSize = 16
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.TextEffect.FontItalic = msoTrue
End With
strTemp = Dir
Loop

strPath = ActivePresentation.Path & "\MEDIA\"
strFileSpec = "*.*"
strTemp = Dir(strPath & strEquip2 & "\" & strFileSpec)
Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strEquip2 & "\" & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)
Set oBoxTop = oSld.Shapes.AddShape(msoShapeRectangle, _
Left:=0, Top:=0, Width:=720, Height:=60)
Set oBoxBottom = oSld.Shapes.AddShape(msoShapeRectangle, _
Left:=0, Top:=480, Width:=720, Height:=60)
Set oTxt = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=0, Width:=720, Height:=60)
Set oTxt2 = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=494, Width:=685, Height:=50)
Set oTxt3 = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=0, Top:=514, Width:=685, Height:=50)
Set oPic2 = oSld.Shapes.AddPicture(FileName:=strPath & "crest.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=680, _
Top:=485, _
Width:=-1, _
Height:=-1)

With oPic
If 3 * .Width > 4 * .Height Then
.Width = ActivePresentation.PageSetup.SlideWidth
.Top = 0.5 * (ActivePresentation.PageSetup.SlideHeight - .Height)
Else
.Height = ActivePresentation.PageSetup.SlideHeight
.Left = 0.5 * (ActivePresentation.PageSetup.SlideWidth - .Width)
End If

End With
With oBoxTop
.Fill.ForeColor.RGB = RGB(30, 123, 193)
.Line.ForeColor.RGB = RGB(30, 123, 193)
End With
With oBoxBottom
.Fill.ForeColor.RGB = RGB(30, 123, 193)
.Line.ForeColor.RGB = RGB(30, 123, 193)
End With
With oTxt
.TextFrame.TextRange.Text = strTemp
.TextEffect.FontName = "Palatino Linotype (Body)"
.TextEffect.Alignment = msoTextEffectAlignmentCentered
.TextEffect.FontSize = 43
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
'.Fill.ForeColor.RGB = RGB(30, 123, 193)
.TextFrame.TextRange.Replace Findwhat:=".jpg", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:=".png", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:=".gif", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(1)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(2)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(3)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(4)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(5)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(6)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(7)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(8)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(9)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(10)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(11)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(12)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(13)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(14)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(15)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(16)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(17)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(18)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(19)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(20)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(21)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(22)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(23)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(24)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(25)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(26)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(27)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(28)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(29)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(30)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(31)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(32)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(33)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(34)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(35)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(36)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(37)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(38)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(39)", ReplaceWhat:=""
.TextFrame.TextRange.Replace Findwhat:="(40)", ReplaceWhat:=""
.AnimationSettings.EntryEffect = ppEffectAppear
End With

With oTxt2
.TextFrame.TextRange.Text = "349(F)Squadron"
.TextEffect.FontName = "Palatino Linotype"
.TextEffect.Alignment = msoTextEffectAlignmentRight
.TextEffect.FontSize = 16
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.TextEffect.FontItalic = msoTrue
End With

With oTxt3
.TextFrame.TextRange.Text = "Strike Hard Strike Home"
.TextEffect.FontName = "Palatino Linotype"
.TextEffect.Alignment = msoTextEffectAlignmentRight
.TextEffect.FontSize = 16
.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.TextEffect.FontItalic = msoTrue
End With
strTemp = Dir
Loop




ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB = RGB(30, 123, 193)

End Sub


17552
John Wilson
11-09-2016, 08:58 AM
I appreciate you posting your code but I'm afraid I can't work out what it is supposed to do. Maybe this example of how to create a picker to add images to slides will help. Make sure you alter the initial folder.

17554