Private Sub Form_Load()
    List1.AddItem "10"
    List1.AddItem "90"
    List1.AddItem "45"
    List1.AddItem "80"
    List1.AddItem "79"
    List1.AddItem "50"

    Picture1.Move 120, 120, 5400, 1800
    Picture1.AutoRedraw = True 
    Picture1.FillStyle = "0" 'solid 

    ZeichneBalkenEnd Sub

Private Sub ZeichneBalken()

On Error Resume Next 

Dim Farbe As Long ' für verschiedene Balken 
Picture1.Cls ' Picturebox leeren 
Dim oldFontSize%

Dim oldForecolor%

oldFontSize = Picture1.FontSize 'speichert aktuelle Schrift 
oldForecolor = Picture1.ForeColor

Picture1.Width = (1000 * List1.ListCount) + 200

' Eigene Skalierung: 
Picture1.Scale (-15, 120)-(250, -20)

' Grundgerüst 

Picture1.Line (10, 0)-(10, 100) 'vertikal 

Picture1.Line (10, 0)-(250, 0) 'horizontal 

Picture1.FontSize = 8
Picture1.ForeColor = RGB(128, 128, 128)

Dim I As Integer 

' Skalierung vertikal (Bezeichnungen) 
    For I = 100 To 0 Step -20
        Picture1.Line (5, I)-(10, I)
        Picture1.CurrentX = -5
        Picture1.CurrentY = Picture1.CurrentY + 10
        Picture1.Font = "Arial"
        Picture1.Print I
    Next I

'Gridlines zeichnen 
Picture1.ForeColor = RGB(200, 200, 200)
  For I = 100 To 10 Step -20
    Picture1.Line (12, I)-(250, I)
  Next I

'zurücksetzen der Schriftfarbe für 

'evtl. spätere Aktionen 

Picture1.ForeColor = oldForecolor

Dim Sum As Long 
Sum = 0
' berechne Grafik vom höchsten Wert 

' höchsten Wert ermitteln: 

Dim zz As Long 

For zz = 0 To List1.ListCount - 1
    If List1.List(zz) > Sum Then 
    Sum = List1.List(zz)
    End If 

Next zz

Dim Anzahl As Long 

' Liste durchlaufen 
  For Anzahl = 0 To List1.ListCount - 1
    Y1 = (List1.List(Anzahl) * 100) / (Sum)
    'einzelne Balken im Diagramm zeichnen. 
    If Y1 > 0 Then 
      Farbe = Farbe + 1
      ' Wiederholung ab der 5. Farbe: 
      If Farbe > 5 Then Farbe = 1
      Select Case Farbe
        Case 1
	Picture1.FillColor = RGB(250, 95, 50) 'rot 
        Case 2
	Picture1.FillColor = RGB(239, 210, 143) 'gelb 
        Case 3
	Picture1.FillColor = RGB(113, 186, 221) 'blau 
        Case 4
	Picture1.FillColor = RGB(237, 135, 222) 'magenta 
        Case 5
	Picture1.FillColor = RGB(148, 204, 132) 'grün 
      End Select

    'aber jetzt wird gezeichnet: 
    Picture1.Line (Anzahl + (Anzahl * 15) + 10, Y1)-(Anzahl + (Anzahl * 15) + 25, 0), , B
    Picture1.CurrentX = (Anzahl + (Anzahl * 15) + 11)
    Picture1.CurrentY = 0
    Picture1.Print Left(List1.List(Anzahl), 5) 'nur die ersten 5 Chars 

    ' Prozentanzeige oben 
    Picture1.CurrentX = (Anzahl + (Anzahl * 15) + 11)
    Picture1.CurrentY = 120
    Picture1.Print " " & Format(Y1, "00") & " %"

    End If 

Next Anzahl

End Sub