Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
268to272
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
268to272
268to272
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro

Makro
17.06.2003 07:26:03
Elisa
Hallo Zusammen,

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




1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Makro
17.06.2003 16:59:11
Mike E.

Hallo Elisa,

ohne dein Makro genau betrachtet zu haben, schlge ich vor, anstelle von Loops, For/Next-Schleifen zu verwenden; so kannst du auch die Schritte definieren:

For i = 1 to 1000 Step 10

Gruß
Mike

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige