Office: Linien Zeichnen und platzieren via VBA

Pluto1 · 7. Oktober 2009

Hoi Zäme

Möchte in einer Excel-Liste eine Art "Muster" hinterlegen. Dieses Muster symbolisiert die Schichteinteilung und ist pro Stelle verschieden. Insgesamt gibt es 5 Varianten. Die betreffende Variante ist für den ganzen Monat für 26 Personen einzutragen.

Person 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 etc Tag

Müller
Meier
etc

Beiliegend Liste mit den verschiedenen Varianten und wie sie endgültig aussehen sollte.

Es ist eine Dienstliste die jährlich wiederkehrend gebraucht wird. Monate werden in Tabellenblätter Jan - Dez. notiert.
Ich möchte die verschiedenen Varianten via Makro oder Commando-Buttons in die entsprechenden Stellen einfügen.

Hab versucht ein Makro zu erstellen. Funktioniert eigentlich auch ausser, ich kann/weiss nicht wie ich die Startposition angeben soll und weiss auch nicht wie ich das einfach machen kann, dass es sich auf 26 Zeilen wieder holen soll. Kann mir jemand helfen?

Makro

Sub Makro1()
'
' Makro1 Makro
' Makro am 09.10.2009 von aufgezeichnet
'

ActiveSheet.Shapes.AddLine(69#, 41.5, 86#, 41.5).Select
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
ActiveSheet.Shapes.AddLine(89.5, 41.5, 92.5, 41.5).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
ActiveSheet.Shapes.AddLine(97#, 41.5, 100#, 41.5).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
ActiveSheet.Shapes.AddLine(103#, 41.5, 120#, 41.5).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
ActiveSheet.Shapes.AddLine(120#, 41.5, 139#, 41.5).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
ActiveSheet.Shapes.AddLine(154#, 41.5, 173#, 41.5).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 11
End Sub
*frown.gif*

:)

Pluto1 · 9. Oktober 2009

Sorry Anbei noch Excel-Dokument

knacko · 9. Oktober 2009

Hi

probiere es mal damit:

Code:

Option Explicit
Sub Markierung()
Dim LShape As Shape, shpGroup As Shape
Dim i%, j%, k%, Sx%, Sy%, LLange%, iSum%, jSum% '% '%=Integer
Dim start_cell As Range
Dim varArr() As Variant
Dim intAnzahl%

' Start z.b. D9, kann aber über variablen gesteuert werden
Set start_cell = ActiveSheet.Cells(9, 4) 'Cells(Reihe, Spalte)
' i = ActiveCell.Width: j = ActiveCell.Height
iSum = 0: jSum = 0
LLange = 86
k = 1
Set LShape = ActiveSheet.Shapes.AddLine(0, 0, LLange, 0) ' BeginX,BeginY,EndX,EndY,

With LShape
.Line.Weight = 0.75
.Line.ForeColor.SchemeColor = 11
.Name = "Line" & k

'Hier erfolgt Berechnung der Position
'Kumulieren der Spaltenbreiten/Zeilenhoehen bis einschl.
'der aktiven Zelle
For i = 1 To start_cell.Column
iSum = iSum + Columns(i).Width
Next i
For j = 1 To start_cell.Row
jSum = jSum + Rows(j).Height
Next j
'Setzen der berechneten Position
.Left = iSum
.Top = jSum
' Application.Wait Now + TimeValue("00:00:02") 'kurz warten
'weitere Verschiebung
.Left = .Left - start_cell.Width
.Top = .Top - start_cell.Height
Sx = .Left '- start_cell.Width
Sy = .Top '- start_cell.Height
k = k + 1
End With
'

' Neuer Starwert in X
Sx = Sx + LLange
LLange = 20
Set LShape = ActiveSheet.Shapes.AddLine(Sx, Sy, Sx + LLange, Sy) ' BeginX,BeginY,EndX,EndY,
With LShape
.Line.Weight = 1
.Name = "Line" & k
.Line.ForeColor.SchemeColor = 45
k = k + 1
End With

' Neuer Starwert in X
Sx = Sx + LLange
LLange = 10
Set LShape = ActiveSheet.Shapes.AddLine(Sx, Sy, Sx + LLange, Sy) ' BeginX,BeginY,EndX,EndY,
With LShape
.Line.Weight = 1
.Name = "Line" & k
.Line.ForeColor.SchemeColor = 20
k = k + 1
End With

' Gruppieren klappt aber nicht so richtig
For i = 1 To k - 1
ReDim Preserve varArr(1 To i)
varArr(i) = "Line" & i
Next i
Set shpGroup = ActiveSheet.Shapes.Range(varArr).Group
Set shpGroup = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Linien Zeichnen und platzieren via VBA

Linien Zeichnen und platzieren via VBA

Linien Zeichnen und platzieren via VBA

Linien Zeichnen und platzieren via VBA - Similar Threads - Linien Zeichnen platzieren

Löschen von horizontaler Linie

Schwarze Linie oben in Word Dokument

komiesch Zahlen und Linien links in der Folie

Balkendiagramm mit Linien/Kombidiagramm erstellen

Zeichnen oder Löschen einer Linie oder eines Verbinders

VBA Linie zeichnen

Zeichnen gerader Linien oder Ausrichten von Dingen mit dem Lineal in PowerPoint