|
Das ist nicht genau das, was ich suche. Also ich weiß, wie ich ein Shape einfüge und kann so in etwa die erste Position bestimmen, aber leider nicht genau. Ich möchte mehrere Kreise in Abhängigkeit von ihrem Datum (abhängig vom ersten Tabellenblatt) einfügen. Wenn ich den ersten Kreis auf Position 0 setze, dann klappt das. Er befindet sich dann ganz am Anfang, wo er auch hin soll.
Ich glaube der Fehler liegt in der Umrechnung von Pixel auf den Maßstab in VBA. Kann mir da jemand helfen
jahr = Mid(Sheets("Übersicht").Cells(b, a), 7, 4)
If jahr <> "" Then
'If jahr = "2010" Then
'Cells(d, c).Select
Set start_cell = ActiveSheet.Cells(d, c)
isum = (jahr - 2010) * 12
jsum = 5 'isum = X-Achse, jsum = Y-Achse
'Set dshape = ActiveSheet.Shapes.AddShape(msoShapeDiamond, 12, 12, 12, 12) ' BeginX,BeginY,EndX,EndY,
Set dshape = ActiveSheet.Shapes.AddShape(msoShapeOval, 12, 12, 12, 12)
With dshape
.Name = "Termin"
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.Transparency = 0#
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Line.Visible = msoTrue
.Line.Weight = 0.5
.Line.ForeColor.RGB = RGB(0, 0, 0)
'dshape.Select
'Selection.ShapeRange.IncrementLeft 48
'Selection.ShapeRange.IncrementTop 7.5
'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
.left = .left - start_cell.Width ' + (1 / 34 * CDbl(Cells(b, a)) * start_cell.Width)
.top = .top - start_cell.Height
End With
Gruß
rafa
|