Hello,
I am stumped on an issue an amateur of hack at VBA. I have tried to find a solution on-line but have failed in every attempt. So I defer to the knowledge of this group to possibly help me.
I am trying to create a message box to prompts users to save an extracted PowerPoint file, using a standardized naming solution i would reference in the source excel file, similar to the way I have done in the code is use for excel output. I know how to do it when hard coded value files from excel to another excel. Code I use, that works well is below:
I would like to do this same exercise with an extracted powerpoint file. The code I have up to that point is as follows. I can't for some reason figure out how to make the msg box function and then get the proper save:
Thank you in advance for any suggestions.
</number<sfdc#></id></name<client></number<sfdc#></id></name<client>
I am stumped on an issue an amateur of hack at VBA. I have tried to find a solution on-line but have failed in every attempt. So I defer to the knowledge of this group to possibly help me.
I am trying to create a message box to prompts users to save an extracted PowerPoint file, using a standardized naming solution i would reference in the source excel file, similar to the way I have done in the code is use for excel output. I know how to do it when hard coded value files from excel to another excel. Code I use, that works well is below:
Code:
' Input box to name new file
NewName = InputBox("REQUIRED NAMING FORMAT:" & vbCr & _
" " & vbCr & _
"Name<name<client name=""> <id>_Number<number<sfdc#>_YYYY.MM.DD_v#_Mini CFO Briefing" & vbCr & _
" " & vbCr & _
"EX: GBR Inc_27sf7_2018.09.01_v2.0_Mini CFO Briefing" & vbCr & _
" " & vbCr & _
"Adjust Input Box as needed, based on Naming Requirements demonstrated above:", "New Copy", Range("Title_MiniCFOB").Value)
' Save it with the NewName and in the same directory as original
fpath = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=fpath & NewName & ".xlsb", FileFormat:=50
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
MsgBox "Packet has been saved at current tool location. Please REVIEW before distribution."
Code:
Sub PowerPt_VRB_CompactDash()
' PURPOSE: Create only Compact Review slide '
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShapeRange As Object
If ActiveWorkbook.Name <> ThisWorkbook.Name Then End
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
myPresentation.PageSetup.SlideSize = 2
'Add a slide to the Presentation '11 = ppLayoutTitleOnly
Set mySlide = myPresentation.slides.Add(1, 11)
'Copy Excel Range
Range("Review_1_Compact").Copy
'Paste to PowerPoint and position '2 = ppPasteEnhancedMetafile
mySlide.Shapes.PasteSpecial DataType:=2
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
'Set position: '1 = ppAlignLeft
myShapeRange.Left = 35
myShapeRange.Top = 75
myShapeRange.ScaleHeight 1.05, msoFalse
myShapeRange.ScaleWidth 1.3, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Text = "Compact Review Dashboard"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Name = "Arial"
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Size = 22
mySlide.Shapes.Title.TextFrame.TextRange.Characters.Font.Bold = True
mySlide.Shapes.Title.ScaleHeight 0.3, msoFalse
mySlide.Shapes.Title.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = 1
'Clear The Clipboard
Application.CutCopyMode = False
' Input box to name new file
NewName = InputBox("REQUIRED NAMING FORMAT:" & vbCr & _
" " & vbCr & _
"<name<client name="">Name_Number<id><number<sfdc#>_YYYY.MM.DD_Compact_v#" & vbCr & _
" " & vbCr & _
"EX: GBR Inc_27sf7_2018.09.01_Compact_v2.0" & vbCr & _
" " & vbCr & _
"Adjust Input Box as needed, based on Naming Requirements demonstrated above:", "New Copy", Range("Title_CompactDash").Value)
' My every attempt to do this fails HERE
' Upon close, reminder message to user
MsgBox "Packet has been saved at current tool location. Please REVIEW before distribution."
End Sub
Thank you in advance for any suggestions.
</number<sfdc#></id></name<client></number<sfdc#></id></name<client>
Last edited: