VBA-Convert Julian Dates

[Guest]

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?

 

[David M. Marcovitz]

I see a couple of problems. First d2Julian requires something of type
date. myDate is a variant being used as a String. You might want to try:

Dim myDate As String
Dim myRealDate As Date

myDate = InputBox("Enter a Date", "DateBox (MTC Tech Inc.)", Date)
myRealDate = myDate

myRealDate = d2Julian(myRealDate)

This will convert the String to a Date, but I don't know if it is going
to be the date you really want. Next, you use the variable JulianDate in
txtBoxJDate, but this is not a global variable, so if you use the code
above it will assign your result to myRealDate, and you need to put
myRealDate in your text box. However, this doesn't seem to give you the
right result. At least it differs from any Julian date converters I could
find online. Perhaps you need the string version for the Julian date:

myDate = d2Julian(myRealDate)

and put myDate into your text boxes.

--David

--
David M. Marcovitz
Microsoft PowerPoint MVP
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/

 

[Guest]

David,
Thanks for the push in right direction! This is the layout that
actually works. Really appreciate the assist!

Sub txtBoxJDate()
Dim myDate As String
Dim myRealDate As Date
Dim jDate As String

myDate = InputBox("Enter a Date", "Julian Date Box", Date)
myRealDate = myDate
jDate = d2Julian(myRealDate)

' 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 " & jDate & "."
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

' No change to the original function.