K
kraves
(I posted this over at VBAex - so apologies for those who read both forums)
Hi, I've been been trying to make a Ticker equivalent in powerpoint.
A single slide (that auto loops) with a ticker crawling across bottom. It
updates from a single line text file.
I started with a textbox, got it working fine, except it will always
wordwrap at around 67 characters even with wordwrap false. Here's a code
snippet
I was trying. There's more tags than needed because I was trying to solve
the wrap problem.
Any Ideas to solve this one? Am I missing a tag somewhere?
---------------------
Sub UpdateTickerText()
Dim oShp, oNewShp As Shape
Dim Temp
Dim InputBuffer As String
Dim FileNum As Integer
FileNum = FreeFile
'Select Shape with Ticker Text
Set oShp = ActiveWindow.Selection.SlideRange.Shapes("Text Box 10")
If Not TickerFileName <> "" Then SelectTickerTextFile
If Dir$(TickerFileName) <> "" Then ' the file exists, it's safe to
continue
Open TickerFileName For Input As FileNum
While Not EOF(FileNum)
Input #FileNum, InputBuffer
With oShp.TextFrame
'.DeleteText
.TextRange.Text = InputBuffer
.WordWrap = msoFalse
.TextRange.Font.Name = TickerFont
.TextRange.Font.Size = TickerSize
.TextRange.ChangeCase (ppCaseUpper)
.AutoSize = ppAutoSizeNone
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextRange.ParagraphFormat.WordWrap = msoFalse
End With
Wend
Close FileNum
End If
End Sub
---------------------
So I moved on to use wordart which is basically working fine until I hit a
199/200 char limit. I'm guessing this is the max length of wordart text.
Here's a snippet:
---------------------
Sub UpdateWordArtTickerText()
Dim oShp As Shape
Dim NewEff As Effect
Dim InputBuffer As String
Dim BufferLen As Single
Dim FileNum As Integer
FileNum = FreeFile
'Delete Ticker Shape if it exists
For Each oShp In ActivePresentation.Slides(1).Shapes
If oShp.AlternativeText = "TICKER" Then oShp.Delete
Next
If Not TickerFileName <> "" Then SelectTickerTextFile
If Dir$(TickerFileName) <> "" Then ' the file exists, it's safe to
continue
Open TickerFileName For Input As FileNum
If Not EOF(FileNum) Then
Input #FileNum, InputBuffer 'Read first line of text
file only
InputBuffer = UCase(InputBuffer) 'to Uppercase
BufferLen = Len(InputBuffer) 'use length to set speed
'Maximum length for wordart is 199, just cut of string at this
stage
If BufferLen > 199 Then
BufferLen = 199
InputBuffer = Mid(InputBuffer, 1, 199)
End If
'Create new Ticker using wordart object
Set oShp =
ActiveWindow.Selection.SlideRange.Shapes.AddTextEffect _
(PresetTextEffect:=msoTextEffect1, Text:=InputBuffer,
FontName:=TickerFont, _
FontSize:=TickerSize, FontBold:=msoFalse, FontItalic:=msoFalse, _
Left:=TickerLeft, Top:=TickerTop)
oShp.Select
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue 'Change format
settings
.Fill.Solid
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0#
End With
ActiveWindow.Selection.Unselect
oShp.AlternativeText = "TICKER" 'Make it easy to
identify
'Add crawl exit effect to Ticker
Set NewEff =
ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(oShp, _
msoAnimEffectCrawl, msoAnimateLevelNone,
msoAnimTriggerWithPrevious)
With NewEff
' .Timing.Duration = TickerSpeed * BufferLen / 20
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 30# 'Duration in seconds
' .Behaviors.Item(1).Timing.Duration = 30#
.Exit = msoTrue 'Make it Exit Effect,
starts off screen
End With
End If
Close FileNum
End If
End Sub
---------------------
Any ideas on getting around the 200 limit?
Also I can't get the 30sec timing to stick, debugging the routine I can
watch it change, but afterwards custom animation still shows the default 5sec
(Very Slow).
My only thought is to create multiple wordarts end to end, group them, then
animate the group.
Alternatively has anyone coded a similar routine and willing to share?
cheers, kraves
Hi, I've been been trying to make a Ticker equivalent in powerpoint.
A single slide (that auto loops) with a ticker crawling across bottom. It
updates from a single line text file.
I started with a textbox, got it working fine, except it will always
wordwrap at around 67 characters even with wordwrap false. Here's a code
snippet
I was trying. There's more tags than needed because I was trying to solve
the wrap problem.
Any Ideas to solve this one? Am I missing a tag somewhere?
---------------------
Sub UpdateTickerText()
Dim oShp, oNewShp As Shape
Dim Temp
Dim InputBuffer As String
Dim FileNum As Integer
FileNum = FreeFile
'Select Shape with Ticker Text
Set oShp = ActiveWindow.Selection.SlideRange.Shapes("Text Box 10")
If Not TickerFileName <> "" Then SelectTickerTextFile
If Dir$(TickerFileName) <> "" Then ' the file exists, it's safe to
continue
Open TickerFileName For Input As FileNum
While Not EOF(FileNum)
Input #FileNum, InputBuffer
With oShp.TextFrame
'.DeleteText
.TextRange.Text = InputBuffer
.WordWrap = msoFalse
.TextRange.Font.Name = TickerFont
.TextRange.Font.Size = TickerSize
.TextRange.ChangeCase (ppCaseUpper)
.AutoSize = ppAutoSizeNone
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextRange.ParagraphFormat.WordWrap = msoFalse
End With
Wend
Close FileNum
End If
End Sub
---------------------
So I moved on to use wordart which is basically working fine until I hit a
199/200 char limit. I'm guessing this is the max length of wordart text.
Here's a snippet:
---------------------
Sub UpdateWordArtTickerText()
Dim oShp As Shape
Dim NewEff As Effect
Dim InputBuffer As String
Dim BufferLen As Single
Dim FileNum As Integer
FileNum = FreeFile
'Delete Ticker Shape if it exists
For Each oShp In ActivePresentation.Slides(1).Shapes
If oShp.AlternativeText = "TICKER" Then oShp.Delete
Next
If Not TickerFileName <> "" Then SelectTickerTextFile
If Dir$(TickerFileName) <> "" Then ' the file exists, it's safe to
continue
Open TickerFileName For Input As FileNum
If Not EOF(FileNum) Then
Input #FileNum, InputBuffer 'Read first line of text
file only
InputBuffer = UCase(InputBuffer) 'to Uppercase
BufferLen = Len(InputBuffer) 'use length to set speed
'Maximum length for wordart is 199, just cut of string at this
stage
If BufferLen > 199 Then
BufferLen = 199
InputBuffer = Mid(InputBuffer, 1, 199)
End If
'Create new Ticker using wordart object
Set oShp =
ActiveWindow.Selection.SlideRange.Shapes.AddTextEffect _
(PresetTextEffect:=msoTextEffect1, Text:=InputBuffer,
FontName:=TickerFont, _
FontSize:=TickerSize, FontBold:=msoFalse, FontItalic:=msoFalse, _
Left:=TickerLeft, Top:=TickerTop)
oShp.Select
With ActiveWindow.Selection.ShapeRange
.Fill.Visible = msoTrue 'Change format
settings
.Fill.Solid
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0#
End With
ActiveWindow.Selection.Unselect
oShp.AlternativeText = "TICKER" 'Make it easy to
identify
'Add crawl exit effect to Ticker
Set NewEff =
ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(oShp, _
msoAnimEffectCrawl, msoAnimateLevelNone,
msoAnimTriggerWithPrevious)
With NewEff
' .Timing.Duration = TickerSpeed * BufferLen / 20
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 30# 'Duration in seconds
' .Behaviors.Item(1).Timing.Duration = 30#
.Exit = msoTrue 'Make it Exit Effect,
starts off screen
End With
End If
Close FileNum
End If
End Sub
---------------------
Any ideas on getting around the 200 limit?
Also I can't get the 30sec timing to stick, debugging the routine I can
watch it change, but afterwards custom animation still shows the default 5sec
(Very Slow).
My only thought is to create multiple wordarts end to end, group them, then
animate the group.
Alternatively has anyone coded a similar routine and willing to share?
cheers, kraves