msoShape an cell fixieren
28.01.2020 16:33:06
Bo
ich möchte meine msoShape an eine Zelle, in der das aktuelle Datum steht (steht immer in Range (H10:BZL10)), anheften. Hierzu habe ich folgende Syntax geschrieben und bekomme für Ziel.column auch die korrekte spalte raus, nur zählt diese Nummer ja die Spaltenanzahl und nicht den pt. abstand zu left. Wenn mir jemand dabei behilflich sein könnte, wäre das super.
Dim Ziel As Range, Zeile As Long, Spalte As Long
Set Ziel = .Range("H10:BZL10").Find(DateSerial(Year(Date), Month(Date), Day(Date) - 7))
Zeile = 10
Spalte = Ziel.Column
With ActiveWindow
.ScrollColumn = Spalte
.ScrollRow = Zeile
End With
'AddShape ThisWeek
Dim Sh As Shape
Dim i As Integer, r As Integer
Dim heute As Range
Set heute = .Cells(Zeile, Spalte)
Set Sh = ThisWorkbook.Worksheets("Chart").Shapes.AddShape(msoShapeRectangle, 100, 30, 50, 80)
Sh.Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
'Sh.Line.ForeColor.RGB = RGB(153, 51, 0)
Sh.Line.Weight = 3
Sh.Rotation = 0
End With
End Sub