HTML5 Animations with CSS & VBA: Fading in text

Browser GUI technologies are clearly better than VBA's. Html5 is a wonderful leap forward with its animation capabilities. However, sometimes you'll want some code to help avoid fiddling with CSS. Why not VBA?

First Message

Second Message

Third Message

Fourth Message

So I hope you just seen the above messages fade in one after the after. How is this achieved? Firstly, there is the opacity attribute (0 = invisible, 1 = visible). Then we have to animate the opacity and for that need the animation-name, animation-delay and animation-duration attributes. We also need a @keyframes rule to give the schedule for the opacity to change over time, in this example given as percentages. The animation-name attribute must tie in to the identifier given in the @keyframes rule. What follows is the source to drive this simple animation.

HTML to fade in text messages

1. <style>
2.     .allText {
3.         font-size: 2rem;
4.         font-family: sans-serif;
5.         color: #000000;
6.     }
7.  
8.     @keyframes FadeIn10_20 {
9.         0% { opacity: 0; }
10.         10% { opacity: 0; }
11.         20% { opacity: 1; }
12.         100% { opacity: 1; }
13.     }
14.  
15.     .text0 {
16.         animation-name: FadeIn10_20;
17.         animation-delay: 0s;
18.         animation-duration: 10s;
19.     }
20.  
21.     @keyframes FadeIn30_40 {
22.         0% { opacity: 0; }
23.         30% { opacity: 0; }
24.         40% { opacity: 1; }
25.         100% { opacity: 1; }
26.     }
27.  
28.     .text1 {
29.         animation-name: FadeIn30_40;
30.         animation-delay: 0s;
31.         animation-duration: 10s;
32.     }
33.  
34.     @keyframes FadeIn50_60 {
35.         0% { opacity: 0; }
36.         50% { opacity: 0; }
37.         60% { opacity: 1; }
38.         100% { opacity: 1; }
39.     }
40.  
41.     .text2 {
42.         animation-name: FadeIn50_60;
43.         animation-delay: 0s;
44.         animation-duration: 10s;
45.     }
46.  
47.     @keyframes FadeIn70_80 {
48.         0% { opacity: 0; }
49.         70% { opacity: 0; }
50.         80% { opacity: 1; }
51.         100% { opacity: 1; }
52.     }
53.  
54.     .text3 {
55.         animation-name: FadeIn70_80;
56.         animation-delay: 0s;
57.         animation-duration: 10s;
58.     }
59. </style>
60. <div class='allText text0'>First Message</div>
61. <div class='allText text1'>Second Message</div>
62. <div class='allText text2'>Third Message</div>
63. <div class='allText text3'>Fourth Message</div>

Initially, I struggled with the animation directives, I grew frustrated editing source CSS manually so I wrote some VBA to help set the timings because a change in duration of one message had a knock-on effect on the following messages. I needed some code to total the timings in seconds and then express the timing of the animation events as percentages.

I am aware that there are CSS pre-processors out there such as LESS and SASS but I'd rather use VBA. Here is the source

modCSSFadeInAnimation Standard Module

1. Option Explicit 
2. Option Private Module
3.  
4. '*
5. '* Brought to you by the Excel Development Platform Blog
6. '* http://exceldevelopmentplatform.blogspot.com/2018/12/
7. '*
8.  
9. Private mdicLines As Scripting.Dictionary
10.  
11. Private Type udtMessage
12.     sText As String
13.     dStart As Double 'In seconds
14.     dFadeIn As Double 'In seconds
15.     lStartPercentage As Long
16.     lFadeInPercentage As Long
17.     lTop As Long
18.     dDuration As Double 'In seconds
19. End Type
20.  
21. Private Type udtMessages
22.     Messages() As udtMessage
23. End Type
24.  
25. Private mlTotalSeconds As Long
26.  
27. Private Sub Main()
28.  
29.     Dim bFullHtmlDocument As Boolean
30.     bFullHtmlDocument = False '*<---- change to True to get a full html document instead of a fragment
31.  
32.     Dim uMessages As udtMessages
33.  
34.     AddMessage uMessages, 10, 2, "First Message", 2
35.     AddMessage uMessages, 20, 2, "Second Message"
36.     AddMessage uMessages, 30, 2, "Third Message"
37.     AddMessage uMessages, 40, 2, "Fourth Message"
38.  
39.     CalcFades uMessages
40.     OpenStyleTag bFullHtmlDocument
41.     If bFullHtmlDocument Then WritePositioningCSS uMessages
42.     WriteAnimationCSS uMessages ', 30
43.     WriteEndOfStyleBlock bFullHtmlDocument
44.     WriteBody uMessages, bFullHtmlDocument
45.  
46.     Debug.Print Join(mdicLines.Items, vbNewLine)
47.  
48. End Sub
49.  
50. Private Sub AddMessage(ByRef uMessages As udtMessages, ByVal lTop As Long, ByVal dDuration As Double, ByVal sText As String,
51.         Optional dStart0 As Double)
52.     Dim lIndex As Long
53.  
54.     If Not IsArrayInitialized(uMessages) Then
55.         '* not yet initialised
56.         lIndex = 0
57.         ReDim uMessages.Messages(0 To 0) As udtMessage
58.  
59.     Else
60.         lIndex = UBound(uMessages.Messages) + 1
61.         ReDim Preserve uMessages.Messages(0 To lIndex) As udtMessage
62.     End If
63.  
64.     If lIndex = 0 Then
65.         uMessages.Messages(lIndex).dStart = dStart0
66.     Else
67.         uMessages.Messages(lIndex).dStart = uMessages.Messages(lIndex - 1).dStart + uMessages.Messages(lIndex - 1).dDuration
68.     End If
69.     uMessages.Messages(lIndex).sText = sText
70.     uMessages.Messages(lIndex).lTop = lTop
71.     uMessages.Messages(lIndex).dDuration = dDuration
72.  
73. End Sub
74.  
75. Private Function IsArrayInitialized(ByRef uMessages As udtMessages)
76.     On Error GoTo ErrHand
77.     Dim lUbound As Long
78.     lUbound = UBound(uMessages.Messages)
79.     IsArrayInitialized = True
80.     Exit Function
81. ErrHand:
82.  
83. End Function
84.  
85. Private Sub CalcFades(ByRef uMessages As udtMessages, Optional dDefaultFade As Double = 1)
86.  
87.     Dim lLoop As Long
88.  
89.     For lLoop = LBound(uMessages.Messages) To UBound(uMessages.Messages)
90.         If uMessages.Messages(lLoop).dFadeIn = 0 Then
91.             uMessages.Messages(lLoop).dFadeIn = uMessages.Messages(lLoop).dStart - dDefaultFade
92.         End If
93.         If uMessages.Messages(lLoop).dFadeIn < 0 Then uMessages.Messages(lLoop).dFadeIn = 0
94.     Next
95.  
96.     mlTotalSeconds = uMessages.Messages(UBound(uMessages.Messages)).dStart +
97.                     uMessages.Messages(UBound(uMessages.Messages)).dDuration
98.  
99.     For lLoop = LBound(uMessages.Messages) To UBound(uMessages.Messages)
100.         uMessages.Messages(lLoop).lStartPercentage = 100 * uMessages.Messages(lLoop).dStart / mlTotalSeconds
101.         uMessages.Messages(lLoop).lFadeInPercentage = 100 * uMessages.Messages(lLoop).dFadeIn / mlTotalSeconds
102.     Next
103.  
104. End Sub
105.  
106. Private Sub OpenStyleTag(Optional bWriteHtmlTags As Boolean = False)
107.     Set mdicLines = New Scripting.Dictionary
108.     If bWriteHtmlTags Then
109.         AddLine "<!DOCTYPE html>"
110.         AddLine "<html>"
111.         AddLine "<head>"
112.         AddLine "<title>Presentation</title>"
113.         AddLine "<meta name='viewport' content='width=device-width, initial-scale=1'></meta>"
114.     End If
115.     AddLine "<style>"
116.     AddLine ".allText {"
117.     AddLine "  font-size:2rem;"
118.     AddLine "  font-family:sans-serif;"
119.     AddLine "  color: #000000;"
120.     AddLine "}"
121.     AddLine ""
122.  
123. End Sub
124.  
125. Private Sub WritePositioningCSS(ByRef uMessages As udtMessages)
126.     Dim lLoop As Long
127.     For lLoop = LBound(uMessages.Messages) To UBound(uMessages.Messages)
128.         AddLine ".text" & lLoop & " {"
129.         AddLine "  position: absolute;"
130.         AddLine "  left: 5%;"
131.  
132.         If uMessages.Messages(lLoop).lTop = 0 Then
133.             AddLine "  top: " & 5 * (lLoop + 1) & "%;"
134.         Else
135.             AddLine "  top: " & uMessages.Messages(lLoop).lTop & "%;"
136.         End If
137.         AddLine "}"
138.         AddLine ""
139.     Next
140. End Sub
141.  
142. Private Sub WriteAnimationCSS(ByRef uMessages As udtMessages, Optional lTotalSeconds As Variant)
143.  
144.     If Not IsMissing(lTotalSeconds) Then mlTotalSeconds = lTotalSeconds
145.  
146.     Dim lLoop As Long
147.     For lLoop = LBound(uMessages.Messages) To UBound(uMessages.Messages)
148.  
149.         '* write keyframe, store keyframe name
150.         Dim sKeyFrameName As String
151.         KeyFramesFadeIn uMessages.Messages(lLoop).lFadeInPercentage, uMessages.Messages(lLoop).lStartPercentage, sKeyFrameName
152.  
153.         AddLine ".text" & lLoop & " {"
154.         AddLine "  animation-name: " & sKeyFrameName & ";"
155.         AddLine "  animation-delay: 0s;"
156.         AddLine "  animation-duration: " & mlTotalSeconds & "s;"
157.  
158.         AddLine "}"
159.         AddLine ""
160.     Next
161. End Sub
162.  
163. Private Sub WriteEndOfStyleBlock(Optional bWriteHeadTag As Boolean = False)
164.     AddLine "</style>"
165.     If bWriteHeadTag Then AddLine "</head>"
166.  
167. End Sub
168.  
169. Private Sub WriteBody(ByRef uMessages As udtMessages, Optional bWriteHtmlAndBodyTags As Boolean = False)
170.     If bWriteHtmlAndBodyTags Then AddLine "<body>"
171.  
172.     Dim lLoop As Long
173.     For lLoop = LBound(uMessages.Messages) To UBound(uMessages.Messages)
174.  
175.         AddLine "<div class='allText text" & lLoop & "'>" & uMessages.Messages(lLoop).sText & "</div>" 'position: absolute;"
176.     Next
177.  
178.     If bWriteHtmlAndBodyTags Then
179.         AddLine "</body>"
180.         AddLine "</html>"
181.     End If
182.  
183. End Sub
184.  
185. Private Function KeyFramesFadeIn(ByVal lStartPercent As Long, ByVal lEndPercent As Long, ByRef psKeyFrameName As String)
186.  
187.     psKeyFrameName = "FadeIn" & Pad(lStartPercent, 2, "0") & "_" & Pad(lEndPercent, 2, "0")
188.  
189.     AddLine "@keyframes " & psKeyFrameName & " {"
190.     AddLine "    0% { opacity: 0; }"
191.     AddLine "  " & Pad(lStartPercent, 3, " ") & "% { opacity: 0; }"
192.     AddLine "  " & Pad(lEndPercent, 3, " ") & "% { opacity: 1; }"
193.     AddLine "  100% { opacity: 1; }"
194.     AddLine "}"
195.     AddLine ""
196.  
197. End Function
198.  
199. Private Sub AddLine(ByVal sLine As String)
200.     mdicLines.Add mdicLines.Count, sLine
201. End Sub
202.  
203. Private Function Pad(ByVal lNum As Long, ByVal lLen As Long, ByVal sChar As String) As String
204.     If Len(CStr(lNum)) > lLen Then lLen = Len(CStr(lNum))
205.     Pad = Right$(String$(lLen, sChar) & CStr(lNum), lLen)
206. End Function
207.  
208.