ich habe ein Makro, welches dreidimensional Zahlen in Form von eines Koordinatensystems darstellt.
Mein Problem ist, dass er in 100er Schritte zählt, ich jedoch 10er Schritte benötige
Hier die Tabelle dazu und weiter unten das Makro:
Risiko Wahrs. Ent. Auswirkung
Fa x y Durchmesser
1 4 7 9
2 4 6 8
3 5 5 7
4 3 5 9
Sub Makro1()
'Markierung wegsetzen
Range("A1").Select
ActiveSheet.Rectangles.Delete
ActiveSheet.Ovals.Delete
ActiveSheet.TextBoxes.Delete
'Koordinaten des Rechtecks: links oben 50/100, je 100 lang und breit
'neue Koordinaten: 350/10
ActiveSheet.Rectangles.Add(350, 50, 100, 100).Select
ActiveSheet.Rectangles.Add(450, 50, 100, 100).Select
ActiveSheet.Rectangles.Add(350, 150, 100, 100).Select
ActiveSheet.Rectangles.Add(450, 150, 100, 100).Select
' Auswahl.Innenbereich.FarbIndex = xlKein
Count = Application.InputBox("...wie viele Objekte?", "Im Portfolio sind", Type:=1)
If Count = 0 Then GoTo Enden
n = 1
Do While n < Count + 1 ' Äussere Schleife.
n = n + 1 ' Zähler hochzählen.
Lks = Worksheets(1).Cells(n + 1, 2) + 450
Ob = Worksheets(1).Cells(n + 1, 3)
If Ob < 0 Then Ob = Ob * -1 + 150 Else Ob = 150 - Ob
Breit = Worksheets(1).Cells(n + 1, 4)
Hoch = Breit
Lks = Lks - Breit / 2
Ob = Ob - Breit / 2
Firma = Worksheets(1).Cells(n + 1, 1)
'Links, Oben, Breite, Höhe
ActiveSheet.Ovals.Add(0, 0, 0, 0).Select
ActiveSheet.Ovals(n - 1).Left = Lks
ActiveSheet.Ovals(n - 1).Top = Ob
ActiveSheet.Ovals(n - 1).Width = Breit
ActiveSheet.Ovals(n - 1).Height = Hoch
ActiveSheet.Ovals(n - 1).Interior.ColorIndex = n
'Text
ActiveSheet.TextBoxes.Add(Lks, Ob + Hoch, 35, 15).Select
ActiveSheet.TextBoxes(n - 1).AutoSize = True
ActiveSheet.TextBoxes(n - 1).Border.Color = RGB(255, 255, 255)
ActiveSheet.TextBoxes(n - 1).Font.Size = 8
ActiveSheet.TextBoxes(n - 1).Caption = Firma
Loop
' Achsenbeschriftung
'x-Achse
ActiveSheet.TextBoxes.Add(435, 270, 35, 15).Select
ActiveSheet.TextBoxes(n).AutoSize = True
ActiveSheet.TextBoxes(n).Border.Color = RGB(255, 255, 255)
ActiveSheet.TextBoxes(n).Font.Size = 8
xAchse = Worksheets(1).Cells(1, 2)
ActiveSheet.TextBoxes(n).Caption = xAchse
'y-Achse
ActiveSheet.TextBoxes.Add(315, 120, 35, 15).Select
ActiveSheet.TextBoxes(n + 1).AutoSize = True
ActiveSheet.TextBoxes(n + 1).Orientation = xlUpward
ActiveSheet.TextBoxes(n + 1).Border.Color = RGB(255, 255, 255)
ActiveSheet.TextBoxes(n + 1).Font.Size = 8
yAchse = Worksheets(1).Cells(1, 3)
ActiveSheet.TextBoxes(n + 1).Caption = yAchse
'Skalen
dummy = 1
Do While dummy < 7
If dummy < 4 Then ActiveSheet.TextBoxes.Add(325, 45 + (dummy - 1) * 100, 0, 0).Select Else ActiveSheet.TextBoxes.Add(345 + (dummy - 4) * 100, 255, 0, 0).Select
ActiveSheet.TextBoxes(n + 1 + dummy).AutoSize = True
ActiveSheet.TextBoxes(n + 1 + dummy).Border.Color = RGB(255, 255, 255)
ActiveSheet.TextBoxes(n + 1 + dummy).Font.Size = 10
If dummy = 1 Or dummy = 6 Then
ActiveSheet.TextBoxes(n + 1 + dummy).Characters(1, 3).Text = "10"
ElseIf dummy = 2 Or dummy = 5 Then
ActiveSheet.TextBoxes(n + 1 + dummy).Characters(1, 1).Text = "0"
Else
ActiveSheet.TextBoxes(n + 1 + dummy).Characters(1, 3).Text = "-10"
End If
dummy = dummy + 1
Loop
Enden:
Range("A1").Select 'Damit das Makro nicht auf einem belegtem Feld arbeitet
End Sub