P
PSKelligan
Hello all!
Trying to create a text box on each slide in a presentation that give the
Julian date. I am running into a typt mismatch error that I can not seem to
get around. The code is as follows.
Sub txtBoxJDate()
myDate = InputBox("Enter a Date", "DateBox (MTC Tech Inc.)", Date)
Call d2Julian(myDate)
' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType
' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1
' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)
ActiveWindow.Selection.SlideRange.Shapes.AddLabel(msoTextOrientationHorizontal, 334.75, 350.625, 14.5, 21.625).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoFalse
With ActiveWindow.Selection.TextRange.ParagraphFormat
.LineRuleWithin = msoTrue
.SpaceWithin = 1
.LineRuleBefore = msoTrue
.SpaceBefore = 0.5
.LineRuleAfter = msoTrue
.SpaceAfter = 0
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,
Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "Today's Julian Date is " & JulianDate & "."
With .Font
.Name = "Arial"
.Size = 12
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
With ActiveWindow.Selection.ShapeRange.TextFrame
.HorizontalAnchor = msoAnchorCenter
.VerticalAnchor = msoAnchorMiddle
.WordWrap = msoTrue
.AutoSize = ppAutoSizeNone
End With
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = ppShadow
.Fill.Transparency = 0#
.Height = 21.62
.Width = 188.62
.Left = 525.38
.Top = 512.38
End With
Next oSl
' Set the view back
ActiveWindow.ViewType = iOriginalView
End Sub
Function d2Julian(myDate As Date) As String
Dim DateYear As String ' The year of the serial date.
Dim JulianDay As String
Dim JulianDate As String ' The converted Julian date value
' Assign DateYear the year number
DateYear = Format(myDate, "yy")
' Find the day number for myDate
JulianDay = Format(Str(myDate - DateValue("1/1/" & Str(DateYear)) + 1),
"000")
' Combine the year and day to get the value for JulianDate.
JulianDate = DateYear & JulianDay
' Display the new date in the Julian date format.
d2Julian = JulianDate
End Function
Does anyone see where I am falling down?
Trying to create a text box on each slide in a presentation that give the
Julian date. I am running into a typt mismatch error that I can not seem to
get around. The code is as follows.
Sub txtBoxJDate()
myDate = InputBox("Enter a Date", "DateBox (MTC Tech Inc.)", Date)
Call d2Julian(myDate)
' Remember the view you're in now
iOriginalView = ActiveWindow.ViewType
' Set PPT to Slide view
ActiveWindow.ViewType = ppViewSlide
For Each oSl In ActivePresentation.Slides
iSlides = iSlides + 1
' Move proceedure from one slide to the next
ActiveWindow.View.GotoSlide (oSl.SlideIndex)
ActiveWindow.Selection.SlideRange.Shapes.AddLabel(msoTextOrientationHorizontal, 334.75, 350.625, 14.5, 21.625).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoFalse
With ActiveWindow.Selection.TextRange.ParagraphFormat
.LineRuleWithin = msoTrue
.SpaceWithin = 1
.LineRuleBefore = msoTrue
.SpaceBefore = 0.5
.LineRuleAfter = msoTrue
.SpaceAfter = 0
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,
Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "Today's Julian Date is " & JulianDate & "."
With .Font
.Name = "Arial"
.Size = 12
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
With ActiveWindow.Selection.ShapeRange.TextFrame
.HorizontalAnchor = msoAnchorCenter
.VerticalAnchor = msoAnchorMiddle
.WordWrap = msoTrue
.AutoSize = ppAutoSizeNone
End With
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = ppShadow
.Fill.Transparency = 0#
.Height = 21.62
.Width = 188.62
.Left = 525.38
.Top = 512.38
End With
Next oSl
' Set the view back
ActiveWindow.ViewType = iOriginalView
End Sub
Function d2Julian(myDate As Date) As String
Dim DateYear As String ' The year of the serial date.
Dim JulianDay As String
Dim JulianDate As String ' The converted Julian date value
' Assign DateYear the year number
DateYear = Format(myDate, "yy")
' Find the day number for myDate
JulianDay = Format(Str(myDate - DateValue("1/1/" & Str(DateYear)) + 1),
"000")
' Combine the year and day to get the value for JulianDate.
JulianDate = DateYear & JulianDay
' Display the new date in the Julian date format.
d2Julian = JulianDate
End Function
Does anyone see where I am falling down?