Excel
Zur Navigation springen
Zur Suche springen
Nützliche VBA Scripte für MS Excel.
Balken mit Prozentwerten beschriften
MS Excel bietet keine Möglichkeit die einzelnen Balken in einem gestapelten Balkendiagramm mit den Prozent- statt absoluten Werten zu beschriften.
Dieses VBA-Makro beschriftet die einzelnen Balken in einem gestapelten Balkendiagramm mit den Prozentwerten. Vorausgesetzt wird, dass die Summe in der letzten Spalte steht (siehe Beispielbild). Die Summe eines Stapels ist über dem Stapel angezeigt.
Labels in Diagramm ändern
Sub PercentLabelChart(myChart As Chart) Dim mySeries As Series Dim SollSeries As Series Dim myPoint As Point Dim i, j As Long If myChart.SeriesCollection.Count > 2 Then Set SollSeries = myChart.SeriesCollection(myChart.SeriesCollection.Count) For i = 1 To myChart.SeriesCollection.Count - 1 Set mySeries = myChart.SeriesCollection(i) For j = 1 To mySeries.Points.Count Set myPoint = mySeries.Points(j) If myPoint.HasDataLabel Then ' myPoint.DataLabel.Text = Format(mySeries.Values(j), "0") myPoint.DataLabel.Text = Format(mySeries.Values(j) / SollSeries.Values(j), "0%") End If Next ' j Next ' i End If End Sub
Aktives Diagramm ändern
Sub ActiveChartPercentLabeling() If Not ActiveChart Is Nothing Then Call PercentLabelChart(ActiveChart) Else MsgBox "Bitte ein Diagramm auswählen!", vbOKOnly, "Fehler: Aktives Diagramm" End If End Sub
Alle Diagramme ändern
Sub ModifyAllCharts() ' ' ModifyAllCharts Makro ' ' Ausgangsbefehl ' ' ActiveChart.SeriesCollection(1).Points(1).DataLabel.Text = "33305" ' Dim mySheet As Worksheet For Each mySheet In Worksheets If mySheet.ChartObjects.Count > 0 Then Call PercentLabelChart(mySheet.ChartObjects(1).Chart) End If Next End Sub
wgetText
Die Funktion wgetText gibt die Antwort einer HTTP-Anfrage als Text zurück. Im Falle einer HTML-Seite ist dies der reine HTML-Code.
Public Function wgetText(url As String) As String Dim responseText As String Dim success As Boolean Dim oHTTP As WinHttp.WinHttpRequest Set oHTTP = New WinHttp.WinHttpRequest With oHTTP .Open Method:="GET", url:=url, async:=False .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; Trident/7.0; rv:11.0) like Gecko" .setRequestHeader "Content-Type", "multipart/form-data; " .Option(WinHttpRequestOption_EnableRedirects) = True .send success = .waitForResponse() If success Then responseText = .responseText Else responseText = "Download failed" End If End With Set oHTTP = Nothing wgetText = responseText End Function