0. Option Explicit
1.
2.
3. Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
4. ( ByVal hwnd As Long, ByVal lpOperation As String, _
5. ByVal lpFile As String, ByVal lpParameters As String, _
6. ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
7.
8.
9. Sub ErzeugeWortwolke()
10.
11. Const iTranzparenz = 1
12.
13. Dim MyFile, MyFileNum
14. Dim iCounter, iMaxHaeufigkeit, iMinHaeufigkeit, iHaeufigkeit, iHervorhebung, iSkalierung As Integer
15. Dim strFontSize1, strFontSize2, strFontSize3, strFontSize4, strFontSize5 As String
16. Dim strTranzparenz, strWort As String
17.
18.
19. MyFile = ThisWorkbook.Path & "\Wortwolke.html"
20.
21.
22. iMaxHaeufigkeit = MaxHaeufigkeit()
23. iMinHaeufigkeit = MinHaeufigkeit()
24.
25.
26. If ((Cells(1, 5).Value = "") Or (Not IsNumeric(Cells(1, 5).Value))) Then
27. MsgBox "Keine Skalierung in Zelle E1 angegeben", vbOKOnly, "Fehler"
28. Else
29.
30. strFontSize1 = Str(Round(1.5 * Cells(1, 5).Value / 100, 1))
31. strFontSize2 = Str(Round(1.8 * Cells(1, 5).Value / 100, 1))
32. strFontSize3 = Str(Round(2.4 * Cells(1, 5).Value / 100, 1))
33. strFontSize4 = Str(Round(2.9 * Cells(1, 5).Value / 100, 1))
34. strFontSize5 = Str(Round(3.5 * Cells(1, 5).Value / 100, 1))
35.
36.
37. MyFileNum = FreeFile()
38. Open MyFile For Output As #MyFileNum
39.
40.
41. Print #MyFileNum, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
42. Print #MyFileNum, "<html>"
43. Print #MyFileNum, " <head>"
44. Print #MyFileNum, " <title>Wortwolke</title>"
45.
46.
47. Print #MyFileNum, " <style type=""Text/css"">"
48. Print #MyFileNum, " #tagcloud { text-align:top; width:100%; } "
49. Print #MyFileNum, " .tag1 { font-size:" & strFontSize1 & "em; color:#C0C0C0; margin: 0.3em;}"
50. Print #MyFileNum, " .tag2 { font-size:" & strFontSize2 & "em; color:#A0A0A0; margin: 0.3em; }"
51. Print #MyFileNum, " .tag3 { font-size:" & strFontSize3 & "em; color:#808080; margin: 0.3em; }"
52. Print #MyFileNum, " .tag4 { font-size:" & strFontSize4 & "em; color:#606060; margin: 0.3em; }"
53. Print #MyFileNum, " .tag5 { font-size:" & strFontSize5 & "em; color:#404040; margin: 0.3em; }"
54. Print #MyFileNum, " </style>"
55. Print #MyFileNum, " </head>"
56.
57.
58. Print #MyFileNum, " <body>"
59. Print #MyFileNum, " <div id=""tagcloud"">"
60.
61.
62. If iTranzparenz = 0 Then
63. strTranzparenz = "background-color:#CCCCCC; border:solid; border-width:1px; "
64. Else
65. strTranzparenz = "background-color:transparent; "
66. End If
67.
68.
69. Print #MyFileNum, " <span style=""position:absolute; left:0px; float:left; height:100%; width:100%; z-index:-1; "">"
70. Print #MyFileNum, " <object data=""Wortwolke.svg"" type=""image/svg+XML"" width=""100%"" height=""100% "">"
71. Print #MyFileNum, " Ihr Browser kann SVG-Objekte leider nicht anzeigen. Nutzen Sie Firefox 3 oder höher!"
72. Print #MyFileNum, " </object>"
73. Print #MyFileNum, " </span>"
74.
75.
76. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:10%; width:100%; " & strTranzparenz & " ""></span>"
77.
78.
79. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:20%; width:20%; " & strTranzparenz & " clear:left;""></span>"
80. Print #MyFileNum, " <span style=""position:relative; right:0px; float:right; height:20%; width:10%; " & strTranzparenz & " ""></span>"
81.
82.
83. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:15%; width:10%; " & strTranzparenz & " clear:left;""></span>"
84. Print #MyFileNum, " <span style=""position:relative; right:0px; float:right; height:15%; width:5%; " & strTranzparenz & " ""></span>"
85.
86.
87. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:25%; width:5%; " & strTranzparenz & " clear:left;""></span>"
88. Print #MyFileNum, " <span style=""position:relative; right:0px; float:right; height:25%; width:2%; " & strTranzparenz & " ""></span>"
89.
90.
91. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:10%; width:8%; " & strTranzparenz & " clear:left;""></span>"
92. Print #MyFileNum, " <span style=""position:relative; right:0px; float:right; height:10%; width:18%; " & strTranzparenz & " ""></span>"
93.
94.
95. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:10%; width:10%; " & strTranzparenz & " clear:left;""></span>"
96. Print #MyFileNum, " <span style=""position:relative; right:0px; float:right; height:10%; width:23%; " & strTranzparenz & " ""></span>"
97.
98.
99. Print #MyFileNum, " <span style=""position:relative; left:0px; float:left; height:400; width:100%; " & strTranzparenz & " ""></span>"
100.
101.
102. iCounter = 1
103. While (Cells(iCounter, 1).Value <> "")
104.
105. strWort = Cells(iCounter, 1).Value
106. iHaeufigkeit = Cells(iCounter, 2).Value
107.
108.
109. iHervorhebung = Int((iHaeufigkeit - iMinHaeufigkeit) / (iMaxHaeufigkeit - iMinHaeufigkeit) * 4) + 1
110.
111.
112. Print #MyFileNum, " <span class=""tag" & iHervorhebung & """>" & strWort & "</span>"
113. iCounter = iCounter + 1
114. Wend
115.
116.
117. Print #MyFileNum, " </div>"
118. Print #MyFileNum, " </body>"
119. Print #MyFileNum, "</html>"
120.
121.
122. Close #MyFileNum
123.
124.
125. ShellExecute Application.hwnd, " Open", MyFile, vbNullString, vbNullString, vbNormalFocus
126. End If
127. End Sub
128.
129. Function MinHaeufigkeit()
130. Dim iCounter, iMinInt
131.
132. iMinInt = 0
133. iCounter = 1
134. iMinInt = Cells(iCounter, 2).Value
135. iCounter = 1
136. While (Cells(iCounter, 1).Value <> "")
137. If iMinInt > Cells(iCounter, 2).Value Then
138. iMinInt = Cells(iCounter, 2).Value
139. End If
140. iCounter = iCounter + 1
141. Wend
142. MinHaeufigkeit = iMinInt
143. End Function
144.
145. Function MaxHaeufigkeit()
146. Dim iCounter, iMaxInt
147.
148. iMaxInt = 0
149. iCounter = 1
150. While (Cells(iCounter, 1).Value <> "")
151. If iMaxInt < Cells(iCounter, 2).Value Then
152. iMaxInt = Cells(iCounter, 2).Value
153. End If
154. iCounter = iCounter + 1
155. Wend
156. MaxHaeufigkeit = iMaxInt
157. End Function