C
Chris Symonds
Hi,
I'm trying to modify some VAB snippets. One comes from a presentation where
the code is displayed via the Project window under the MS PP Objects section
and is assigned to a specific slide and runs via a command button. It takes
info from text boxes (tbLName etc) on the slide and exports it to an Excel
file.
The rest came from a differrent presentation where they were in a module and
run in response to an Action button. They get the user name and print it out
on a certificate when the presentation is viewed.
I'd like to only have the user enter their info once and get both things
done. But if I try to put either bit of code in the other location (slide to
module or vice versa) it doesn't run. Can someone help me understand the
difference between code in the two locations so I can get this working?
'The first sub works from a slide via command button
Private Sub btnSubmit_Click()
Dim oAppXL As Object 'Declare the Excel application object
Dim strPath As String 'Let's the database location be in same
'location as presentation
'no matter what drive you are on
'First check if all the required fields are completed
If tbLName.Text = "" Or tbFName.Text = "" Or tbEmpNo.Text = "" Or
tbWorkAssignment.Text = "" Or tbDate.Text = "" Then
MsgBox "A necessary field is empty. Please check your " _
& "entries and submit again.", vbExclamation
Exit Sub
Else
'Will use the current path of this presentation to look
'for the Excel file in the same folder.
strPath = ActivePresentation.Path
Set oAppXL = CreateObject("Excel.application")
With oAppXL
'Each Excel command is preceded with an extra "."
'compared to normal code in Excel
'since PPT is actually telling Excel to run the code in Excel.
.workbooks.Open FileName:=strPath & "\" & "PassedQFTest.xls"
'We don't want to see Excel and it doesn't have to be visible to
run
.Visible = False
'Now run Excel and place the values
'This next line refers to the first open cell in column A that
is blank
'It will accept up to 65536 entries and if this
'were a really intelligent application
'it would check for the .row <> 65536 and
'create a new sheet to add more names.
If .Sheets("Database").Range("A65536"). _
End(xlup).Offset(1, 0).Value = "" Then
With .Sheets("Database").Range("A65536").End(xlup).Offset(1,
0)
'Now get the values from the text boxes and
'combobox in PowerPoint & place values in public variables
strUserLName = tbLName.Text
strUserFName = tbFName.Text
strUserEmpNo = tbEmpNo.Text
strUserAssignment = tbWorkAssignment.Text
strDate = tbDate.Text
'Add the values from the PPT page
.Value = strUserLName
.Offset(0, 1).Value = strUserFName
.Offset(0, 2).Value = strUserEmpNo
.Offset(0, 3).Value = strUserAssignment
.Offset(0, 4).Value = strDate
End With
End If
End With
End If
'Turn off warnings in Excel since the file is overwriting an existing file
oAppXL.Application.DisplayAlerts = False
'Wouldn't need to close or Quit if the upfront code handled that
differently
'but it still all happens quickly, so it might be a good idea anyway.
'Close and Save the file, the (True) tells Excel to save it.
oAppXL.activeworkbook.Close (True)
oAppXL.Application.Quit
'Clear the memory used by Excel
Set oAppXL = Nothing
'Now clear the existing values and be ready for a new entry.
tbLName.Text = ""
tbFName.Text = ""
tbEmpNo.Text = ""
tbWorkAssignment.Text = ""
tbDate.Text = ""
'Go to next slide
ActivePresentation.SlideShowWindow.View.Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The following comes from a module and runs via an action button
Sub GetStarted()
strUserLName = InputBox(Prompt:="Type your LAST name as it appears on
the hospital paycheck")
strUserFName = InputBox(Prompt:="Type your FIRST name as it appears on
the hospital paycheck")
strUserEmpNo = InputBox(Prompt:="Type your Employee Number")
strDate = InputBox(Prompt:="Type Today's Date")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub PrintablePage()
Dim printableSlide As Slide
'The following lines are commented out because they have been moved to
the top
'of the module. This will allow PrintResults to use them to hide the
buttons
'before printing and show them again after printing.
'Dim DoneButton As Shape
'Dim printButton As Shape
Set printableSlide = ActivePresentation.Slides.Add(Index:=41, _
Layout:=ppLayoutText)
With printableSlide.Shapes _
.AddShape(1, 50, 200, 550, 50).TextFrame
.TextRange.Text = strUserLName & ", " & strUserFName & " # " &
strUserEmpNo
.TextRange.Font.Size = 24
.TextRange.Font.Bold = True
End With
With printableSlide.Shapes _
.AddShape(1, 50, 50, 550, 100).TextFrame
.TextRange.Text = "Core Measures & Quality Forms"
.TextRange.Font.Size = 36
.TextRange.Font.Bold = True
.MarginBottom = 1
.MarginLeft = 1
.MarginRight = 1
.MarginTop = 1
End With
printableSlide.Shapes(2).TextFrame.TextRange.Text = _
"The above named employee has been determined to be competent" & _
" to perform the above skills. Related policies and procedures" & _
" with competent demonstration are assessed, demonstrated," & _
" and validated by testing on" & strDate & "."
'Set DoneButton = ActivePresentation.Slides(41).Shapes.AddShape _
'(msoShapeActionButtonCustom, 400, 430, 150, 50)
'DoneButton.TextFrame.TextRange.Text = "Done!"
'DoneButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
' DoneButton.ActionSettings(ppMouseClick).Run = "Done"
Set printButton = ActivePresentation.Slides(41).Shapes.AddShape _
(msoShapeActionButtonCustom, 100, 430, 150, 50)
printButton.TextFrame.TextRange.Text = "Print Results"
printButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
printButton.ActionSettings(ppMouseClick).Run = "PrintResults"
ActivePresentation.SlideShowWindow.View.Next
ActivePresentation.Saved = True
End Sub
Sub PrintResults()
'DoneButton.Visible = False 'Added to hide button before printing
printButton.Visible = False 'Added to hide button before printing
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.Add 41, 41
End With
End With
.PrintOut
End With
'DoneButton.Visible = True 'Added to show button again after printing
printButton.Visible = True 'Added to show button again after printing
Done
End Sub
I'm trying to modify some VAB snippets. One comes from a presentation where
the code is displayed via the Project window under the MS PP Objects section
and is assigned to a specific slide and runs via a command button. It takes
info from text boxes (tbLName etc) on the slide and exports it to an Excel
file.
The rest came from a differrent presentation where they were in a module and
run in response to an Action button. They get the user name and print it out
on a certificate when the presentation is viewed.
I'd like to only have the user enter their info once and get both things
done. But if I try to put either bit of code in the other location (slide to
module or vice versa) it doesn't run. Can someone help me understand the
difference between code in the two locations so I can get this working?
'The first sub works from a slide via command button
Private Sub btnSubmit_Click()
Dim oAppXL As Object 'Declare the Excel application object
Dim strPath As String 'Let's the database location be in same
'location as presentation
'no matter what drive you are on
'First check if all the required fields are completed
If tbLName.Text = "" Or tbFName.Text = "" Or tbEmpNo.Text = "" Or
tbWorkAssignment.Text = "" Or tbDate.Text = "" Then
MsgBox "A necessary field is empty. Please check your " _
& "entries and submit again.", vbExclamation
Exit Sub
Else
'Will use the current path of this presentation to look
'for the Excel file in the same folder.
strPath = ActivePresentation.Path
Set oAppXL = CreateObject("Excel.application")
With oAppXL
'Each Excel command is preceded with an extra "."
'compared to normal code in Excel
'since PPT is actually telling Excel to run the code in Excel.
.workbooks.Open FileName:=strPath & "\" & "PassedQFTest.xls"
'We don't want to see Excel and it doesn't have to be visible to
run
.Visible = False
'Now run Excel and place the values
'This next line refers to the first open cell in column A that
is blank
'It will accept up to 65536 entries and if this
'were a really intelligent application
'it would check for the .row <> 65536 and
'create a new sheet to add more names.
If .Sheets("Database").Range("A65536"). _
End(xlup).Offset(1, 0).Value = "" Then
With .Sheets("Database").Range("A65536").End(xlup).Offset(1,
0)
'Now get the values from the text boxes and
'combobox in PowerPoint & place values in public variables
strUserLName = tbLName.Text
strUserFName = tbFName.Text
strUserEmpNo = tbEmpNo.Text
strUserAssignment = tbWorkAssignment.Text
strDate = tbDate.Text
'Add the values from the PPT page
.Value = strUserLName
.Offset(0, 1).Value = strUserFName
.Offset(0, 2).Value = strUserEmpNo
.Offset(0, 3).Value = strUserAssignment
.Offset(0, 4).Value = strDate
End With
End If
End With
End If
'Turn off warnings in Excel since the file is overwriting an existing file
oAppXL.Application.DisplayAlerts = False
'Wouldn't need to close or Quit if the upfront code handled that
differently
'but it still all happens quickly, so it might be a good idea anyway.
'Close and Save the file, the (True) tells Excel to save it.
oAppXL.activeworkbook.Close (True)
oAppXL.Application.Quit
'Clear the memory used by Excel
Set oAppXL = Nothing
'Now clear the existing values and be ready for a new entry.
tbLName.Text = ""
tbFName.Text = ""
tbEmpNo.Text = ""
tbWorkAssignment.Text = ""
tbDate.Text = ""
'Go to next slide
ActivePresentation.SlideShowWindow.View.Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The following comes from a module and runs via an action button
Sub GetStarted()
strUserLName = InputBox(Prompt:="Type your LAST name as it appears on
the hospital paycheck")
strUserFName = InputBox(Prompt:="Type your FIRST name as it appears on
the hospital paycheck")
strUserEmpNo = InputBox(Prompt:="Type your Employee Number")
strDate = InputBox(Prompt:="Type Today's Date")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub PrintablePage()
Dim printableSlide As Slide
'The following lines are commented out because they have been moved to
the top
'of the module. This will allow PrintResults to use them to hide the
buttons
'before printing and show them again after printing.
'Dim DoneButton As Shape
'Dim printButton As Shape
Set printableSlide = ActivePresentation.Slides.Add(Index:=41, _
Layout:=ppLayoutText)
With printableSlide.Shapes _
.AddShape(1, 50, 200, 550, 50).TextFrame
.TextRange.Text = strUserLName & ", " & strUserFName & " # " &
strUserEmpNo
.TextRange.Font.Size = 24
.TextRange.Font.Bold = True
End With
With printableSlide.Shapes _
.AddShape(1, 50, 50, 550, 100).TextFrame
.TextRange.Text = "Core Measures & Quality Forms"
.TextRange.Font.Size = 36
.TextRange.Font.Bold = True
.MarginBottom = 1
.MarginLeft = 1
.MarginRight = 1
.MarginTop = 1
End With
printableSlide.Shapes(2).TextFrame.TextRange.Text = _
"The above named employee has been determined to be competent" & _
" to perform the above skills. Related policies and procedures" & _
" with competent demonstration are assessed, demonstrated," & _
" and validated by testing on" & strDate & "."
'Set DoneButton = ActivePresentation.Slides(41).Shapes.AddShape _
'(msoShapeActionButtonCustom, 400, 430, 150, 50)
'DoneButton.TextFrame.TextRange.Text = "Done!"
'DoneButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
' DoneButton.ActionSettings(ppMouseClick).Run = "Done"
Set printButton = ActivePresentation.Slides(41).Shapes.AddShape _
(msoShapeActionButtonCustom, 100, 430, 150, 50)
printButton.TextFrame.TextRange.Text = "Print Results"
printButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
printButton.ActionSettings(ppMouseClick).Run = "PrintResults"
ActivePresentation.SlideShowWindow.View.Next
ActivePresentation.Saved = True
End Sub
Sub PrintResults()
'DoneButton.Visible = False 'Added to hide button before printing
printButton.Visible = False 'Added to hide button before printing
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.Add 41, 41
End With
End With
.PrintOut
End With
'DoneButton.Visible = True 'Added to show button again after printing
printButton.Visible = True 'Added to show button again after printing
Done
End Sub