sadly the macro recorder is not available for impress, so i am unable to get the working script to assign “fade in” (or any other) animation.
Can someone help me with animation macro script?
Here is the workflow.
- I have pasted the unformatted text box
- Color and bold the text
2.a) splitting the rows and assigning each row a text box.
2.b) Here I want the animation to each split text box in sequence. - deleted the big text box
Here is the working code till splitting the rows. the animation script need to be inserted. below this I have also shown the non-working animation code.
' PasteAndSplitTextBoxWithColor
Sub PasteAndSplitTextBoxWithColor
Dim oDoc As Object
Dim oSlide As Object
Dim oShape As Object
Dim oNewShape As Object
Dim aLines() As String
Dim i As Integer
Dim topMargin As Long
Dim lineSpacing As Long
Dim leftMargin As Long
Dim oSize As New com.sun.star.awt.Size
Dim oPoint As New com.sun.star.awt.Point
Dim oCursor As Object
' Settings
topMargin = 5000 ' Vertical starting point
lineSpacing = 1200 ' Space between lines
leftMargin = 10000 ' Left indent
oDoc = ThisComponent
oSlide = oDoc.CurrentController.CurrentPage
' Paste from clipboard as UNFORMATTED text
Dim dispatcher As Object
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(oDoc.CurrentController.Frame, ".uno:PasteUnformatted", "", 0, Array())
' Get the pasted shape
Dim oSelection As Object
oSelection = oDoc.CurrentController.getSelection()
If oSelection.getCount() <> 1 Then
MsgBox "Please select only one text box."
Exit Sub
End If
oShape = oSelection.getByIndex(0)
If Not oShape.SupportsService("com.sun.star.drawing.TextShape") Then
MsgBox "The selected object is not a text box."
Exit Sub
End If
' Make all text white and bold using text cursor
oCursor = oShape.getText().createTextCursor()
oCursor.CharColor = RGB(255, 255, 255)
oCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
' Split and recreate text boxes
aLines = Split(oShape.getString(), Chr(10))
For i = 0 To UBound(aLines)
oNewShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
' Set position
oPoint.X = leftMargin
oPoint.Y = topMargin + i * lineSpacing
oNewShape.Position = oPoint
' Set size
oSize.Width = 15000
oSize.Height = 1000
oNewShape.Size = oSize
' Add shape to slide BEFORE setting text
oSlide.add(oNewShape)
' Set text and apply color/bold
oNewShape.getText().setString(aLines(i))
oCursor = oNewShape.getText().createTextCursor()
oCursor.CharColor = RGB(255, 255, 255)
oCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
Next i
' Delete original pasted shape
oSlide.remove(oShape)
MsgBox "Done! Lines split into separate text boxes."
End Sub
Below is the code with non-working animation part
Sub PasteAndSplitTextBoxWithColorAndAnimation
Dim oDoc As Object
Dim oSlide As Object
Dim oShape As Object
Dim oNewShape As Object
Dim aLines() As String
Dim i As Integer
Dim topMargin As Long
Dim lineSpacing As Long
Dim leftMargin As Long
Dim oSize As New com.sun.star.awt.Size
Dim oPoint As New com.sun.star.awt.Point
' Settings
topMargin = 5000 ' Vertical starting point
lineSpacing = 1200 ' Space between lines
leftMargin = 10000 ' Left indent
oDoc = ThisComponent
oSlide = oDoc.CurrentController.CurrentPage
' Paste from clipboard as UNFORMATTED text
Dim dispatcher As Object
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(oDoc.CurrentController.Frame, ".uno:PasteUnformatted", "", 0, Array())
' Get the pasted text box (assume it's the last shape on the slide)
Dim oShapes As Object
oShape = oSlide.getByIndex(oSlide.getCount() - 1)
' Split text by line
aLines = Split(oShape.getString(), Chr(10))
' Now create a new box for each line
For i = 0 To UBound(aLines)
oNewShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
' Set position
oPoint.X = leftMargin
oPoint.Y = topMargin + i * lineSpacing
oNewShape.Position = oPoint
' Set size
oSize.Width = 15000
oSize.Height = 1000
oNewShape.Size = oSize
' Add to slide
oSlide.add(oNewShape)
' Set text, color and bold
oNewShape.getText().setString(aLines(i))
oNewShape.CharColor = RGB(255, 255, 255)
oNewShape.CharWeight = com.sun.star.awt.FontWeight.BOLD
' Animate
Dim oEffect As Object
oEffect = oSlide.createEffect(oNewShape, _
com.sun.star.presentation.AnimationEffect.FADE, _
com.sun.star.presentation.AnimationSpeed.MEDIUM, 0)
Next i
' Remove the original pasted box
oSlide.remove(oShape)
MsgBox "Done! Text split and animated."
End Sub