tives
05-15-2013, 12:31 AM
I am using the code below and have a problem
Sub PrintResultsSummary()
Dim CurrentIncorrect As String
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'set to last slide number +1
CurrentIncorrect = ActivePresentation.Slides(37).Shapes(2).TextFrame.TextRange.Text 'set to last slide + 1
ActivePresentation.Slides(37).Shapes(2).TextFrame.TextRange = CurrentIncorrect & vbNewLine & _
"Number of Correct Answers = " & numberCorrect & vbNewLine & _
"Number of Incorrect Answers =" & numberWrong 'set to last slide + 1
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'set to last slide number +1
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.ClearAll
.Add 37, 37 'set to last slide number +1
End With
End With
.PrintOut
End With
Call DeleterResultSummary
End Sub
Sub DeleterResultSummary()
Dim osld As Slide
Dim oShp As Shape
For Each osld In ActivePresentation.Slides
For Each oShp In osld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find("Results Summary") Is Nothing Then
'didn't find it
Else
'found it
osld.Delete
Call Certificate
Exit Sub
End If
End If
Next oShp
Next osld
ActivePresentation.SlideShowWindow.View.GotoSlide (36) 'set to last slide
Call Certificate
End Sub
Sub Certificate()
Dim TestScore As Integer
Dim PassMark As Integer
TestScore = Int((numberCorrect / (numberCorrect + numberWrong)) * 100)
PassMark = 80
If TestScore >= PassMark Then
Call PassCertificate
Else
Call FailCertificate
End If
End Sub
Sub PassCertificate()
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Index:=Pre.Slides.Count + 1, Layout:=ppLayoutCustom)
Sld.Shapes(1).TextFrame.TextRange = "This certificate is presented to"
Sld.Shapes(2).TextFrame.TextRange = UserName
Sld.Shapes(6).TextFrame.TextRange = "who has obtained the following score"
Sld.Shapes(7).TextFrame.TextRange = Int((numberCorrect / (numberCorrect + numberWrong)) * 100) & "%" & vbNewLine
Sld.Shapes(8).TextFrame.TextRange = "PAA Storstar Sample Batching Theory Test" 'SET to name for this test
Sld.Shapes(9).TextFrame.TextRange = "on"
Sld.Shapes(3).TextFrame.TextRange = Date
Sld.Shapes(3).TextFrame.TextRange.Text = Format(Date, "dd mmmm yyyy")
Sld.Shapes(10).TextFrame.TextRange = "The pass mark for this test is 80%" 'SET to pass mark for this test
Sld.Shapes(4).TextFrame.TextRange = TrainersName & vbNewLine & _
"Trainer"
Sld.Shapes(5).TextFrame.TextRange.Text = "Lt.Ahmed Zayed" & vbNewLine & _
"DNA Analysis Branch Manager"
Call SavePassCertificate
End Sub
Sub SavePassCertificate()
Dim osld As Slide
Dim oToday As String
Set osld = ActivePresentation.SlideShowWindow.View.Slide
oToday = osld.Shapes(3).TextFrame.TextRange.Text
osld.Export "C:\Everything\Complete Training Package\Tests\Certificates\" & UserName & oToday & ".jpg", FilterName:="JPG"
Call PrintCertificate
End Sub
Sub FailCertificate()
Dim Pre As Presentation
Dim Sld As Slide
Dim Number As Integer
Number = 1000 * Rnd
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Index:=Pre.Slides.Count + 1, Layout:=ppLayoutText)
Sld.Shapes(1).TextFrame.TextRange = "PAA Storstar Sample Batching Theory Test"
Sld.Shapes(2).TextFrame.TextRange = vbNewLine & _
vbNewLine & _
"Unfortunately you have not been succesfull on this attempt " & UserName & "." & vbNewLine & _
vbNewLine & _
"You scored " & Int((numberCorrect / (numberCorrect + numberWrong)) * 100) & "%." & vbNewLine & _
vbNewLine & _
"The pass mark for this test is 80%." & vbNewLine & _
vbNewLine & _
"Please pass this page and the results summary to your trainer, " & TrainersName & "."
ActivePresentation.SlideShowWindow.View.GotoSlide (37)
Call SaveFailCertificate
End Sub
Sub SaveFailCertificate()
Dim osld As Slide
Set osld = ActivePresentation.SlideShowWindow.View.Slide
osld.Export "C:\Everything\Complete Training Package\Tests\Certificates\" & UserName & "Fail" & Number & ".jpg", FilterName:="JPG"
Call PrintCertificate
End Sub
Sub PrintCertificate()
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'SET to last slide number +1
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.ClearAll
.Add 37, 37 'set to last slide number +1
End With
End With
.PrintOut
End With
Call Deleter
End Sub
Sub Deleter()
Dim osld As Slide
Dim oShp As Shape
Dim CurrentSlide As Integer
For Each osld In ActivePresentation.Slides
For Each oShp In osld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find("The pass mark for this test") Is Nothing Then
'didn't find it
Else
'found it
osld.Delete
Exit Sub
End If
End If
Next oShp
Next osld
End Sub
A results summary (already created) is printed, then deleted. The mark obtained is then calculated, and either a pass of fail certificate is generated. The certificate is then saved as a jpg and then printed. The certificate is then deleted.
Well that is what is supposed to happen...
The certificate is created fine but then it stops....
When I go in to VBA and manually run the save certificate macro that runs fine to. When I run from the Sub Certificate directly it works fine but the whole lot wont run together??
Any ideas?
Sub PrintResultsSummary()
Dim CurrentIncorrect As String
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'set to last slide number +1
CurrentIncorrect = ActivePresentation.Slides(37).Shapes(2).TextFrame.TextRange.Text 'set to last slide + 1
ActivePresentation.Slides(37).Shapes(2).TextFrame.TextRange = CurrentIncorrect & vbNewLine & _
"Number of Correct Answers = " & numberCorrect & vbNewLine & _
"Number of Incorrect Answers =" & numberWrong 'set to last slide + 1
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'set to last slide number +1
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.ClearAll
.Add 37, 37 'set to last slide number +1
End With
End With
.PrintOut
End With
Call DeleterResultSummary
End Sub
Sub DeleterResultSummary()
Dim osld As Slide
Dim oShp As Shape
For Each osld In ActivePresentation.Slides
For Each oShp In osld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find("Results Summary") Is Nothing Then
'didn't find it
Else
'found it
osld.Delete
Call Certificate
Exit Sub
End If
End If
Next oShp
Next osld
ActivePresentation.SlideShowWindow.View.GotoSlide (36) 'set to last slide
Call Certificate
End Sub
Sub Certificate()
Dim TestScore As Integer
Dim PassMark As Integer
TestScore = Int((numberCorrect / (numberCorrect + numberWrong)) * 100)
PassMark = 80
If TestScore >= PassMark Then
Call PassCertificate
Else
Call FailCertificate
End If
End Sub
Sub PassCertificate()
Dim Pre As Presentation
Dim Sld As Slide
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Index:=Pre.Slides.Count + 1, Layout:=ppLayoutCustom)
Sld.Shapes(1).TextFrame.TextRange = "This certificate is presented to"
Sld.Shapes(2).TextFrame.TextRange = UserName
Sld.Shapes(6).TextFrame.TextRange = "who has obtained the following score"
Sld.Shapes(7).TextFrame.TextRange = Int((numberCorrect / (numberCorrect + numberWrong)) * 100) & "%" & vbNewLine
Sld.Shapes(8).TextFrame.TextRange = "PAA Storstar Sample Batching Theory Test" 'SET to name for this test
Sld.Shapes(9).TextFrame.TextRange = "on"
Sld.Shapes(3).TextFrame.TextRange = Date
Sld.Shapes(3).TextFrame.TextRange.Text = Format(Date, "dd mmmm yyyy")
Sld.Shapes(10).TextFrame.TextRange = "The pass mark for this test is 80%" 'SET to pass mark for this test
Sld.Shapes(4).TextFrame.TextRange = TrainersName & vbNewLine & _
"Trainer"
Sld.Shapes(5).TextFrame.TextRange.Text = "Lt.Ahmed Zayed" & vbNewLine & _
"DNA Analysis Branch Manager"
Call SavePassCertificate
End Sub
Sub SavePassCertificate()
Dim osld As Slide
Dim oToday As String
Set osld = ActivePresentation.SlideShowWindow.View.Slide
oToday = osld.Shapes(3).TextFrame.TextRange.Text
osld.Export "C:\Everything\Complete Training Package\Tests\Certificates\" & UserName & oToday & ".jpg", FilterName:="JPG"
Call PrintCertificate
End Sub
Sub FailCertificate()
Dim Pre As Presentation
Dim Sld As Slide
Dim Number As Integer
Number = 1000 * Rnd
Set Pre = ActivePresentation
Set Sld = Pre.Slides.Add(Index:=Pre.Slides.Count + 1, Layout:=ppLayoutText)
Sld.Shapes(1).TextFrame.TextRange = "PAA Storstar Sample Batching Theory Test"
Sld.Shapes(2).TextFrame.TextRange = vbNewLine & _
vbNewLine & _
"Unfortunately you have not been succesfull on this attempt " & UserName & "." & vbNewLine & _
vbNewLine & _
"You scored " & Int((numberCorrect / (numberCorrect + numberWrong)) * 100) & "%." & vbNewLine & _
vbNewLine & _
"The pass mark for this test is 80%." & vbNewLine & _
vbNewLine & _
"Please pass this page and the results summary to your trainer, " & TrainersName & "."
ActivePresentation.SlideShowWindow.View.GotoSlide (37)
Call SaveFailCertificate
End Sub
Sub SaveFailCertificate()
Dim osld As Slide
Set osld = ActivePresentation.SlideShowWindow.View.Slide
osld.Export "C:\Everything\Complete Training Package\Tests\Certificates\" & UserName & "Fail" & Number & ".jpg", FilterName:="JPG"
Call PrintCertificate
End Sub
Sub PrintCertificate()
ActivePresentation.SlideShowWindow.View.GotoSlide (37) 'SET to last slide number +1
With ActivePresentation
With .PrintOptions
.OutputType = ppPrintOutputSlides
.RangeType = ppPrintSlideRange
With .Ranges
.ClearAll
.Add 37, 37 'set to last slide number +1
End With
End With
.PrintOut
End With
Call Deleter
End Sub
Sub Deleter()
Dim osld As Slide
Dim oShp As Shape
Dim CurrentSlide As Integer
For Each osld In ActivePresentation.Slides
For Each oShp In osld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find("The pass mark for this test") Is Nothing Then
'didn't find it
Else
'found it
osld.Delete
Exit Sub
End If
End If
Next oShp
Next osld
End Sub
A results summary (already created) is printed, then deleted. The mark obtained is then calculated, and either a pass of fail certificate is generated. The certificate is then saved as a jpg and then printed. The certificate is then deleted.
Well that is what is supposed to happen...
The certificate is created fine but then it stops....
When I go in to VBA and manually run the save certificate macro that runs fine to. When I run from the Sub Certificate directly it works fine but the whole lot wont run together??
Any ideas?