Error Message Mso Rectangle

[Stefan_Sand]

Hi i want to give colleagues the possibility for a quick time planner and
as far as i thought, i am ready with it, but, maybe i am missing something as i get the error message

argument is not optional at

Set shp = rngBereich.Worksheet.Shapes.AddShape(msoShapeRectangle, Left:=rngTrefferStart.Left, Top:=Target.Top, Width:=rngTrefferStart.Height)

what do i miss?

[HansV]

That error is because you don't set the Height of the shape.
But there is at least one other problem.
The code is executed if Target.Column = 2 (i.e. the modified cell is in column B).
But you then refer to Target.Offset(0, -3), i.e. the cell 3 columns to the left. That is impossible.

[Stefan_Sand]

ok, i correctetd the missing part:



Private Sub Worksheet_Change(ByVal Target As Range)

Dim shp As Shape
Dim rngTrefferStart As Range
Dim rngTrefferEnde As Range
Dim rngBereich As Range

If Target.Column = 2 Then
With Tabelle1

Set rngTrefferStart = .Rows(2).Find(what:=Target.Offset(0, -1).Value, lookat:=xlWhole)
If Not rngTrefferEnde Is Nothing Then

Set rngBereich = .Range(.Cells(Target.Row, rngTrefferStart.Column), .Cells(Target.Row, rngTrefferEnde.Column))

ShapeEntfernen rngBereich

If Target.Value = "" Then ShapeEntfernen rngTrefferStart: Exit Sub

Set shp = rngBereich.Worksheet.Shapes.AddShape(msoShapeRectangle, Left:=rngTrefferStart.Left, Top:=Target.Top, Width:=rngBereich.Width, Height:=rngTrefferStart.Height)

shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
shp.Fill.ForeColor.TintAndShade = 0.5

End If

End If

End With

End If

End Sub


- but now, it says, i have one End if to many...

[HansV]

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim shp As Shape
    Dim rngTrefferStart As Range
    Dim rngTrefferEnde As Range
    Dim rngBereich As Range

    If Target.Column = 2 Then
        Set rngTrefferStart = Rows(2).Find(what:=Target.Offset(0, -1).Value, LookAt:=xlWhole)
        If Not rngTrefferEnde Is Nothing Then
            Set rngBereich = Range(Cells(Target.Row, rngTrefferStart.Column), _
                Cells(Target.Row, rngTrefferEnde.Column))
            ShapeEntfernen rngBereich
            If Target.Value = "" Then
                ShapeEntfernen rngTrefferStart
                Exit Sub
            End If
            Set shp = rngBereich.Worksheet.Shapes.AddShape(Type:=msoShapeRectangle, _
                Left:=rngTrefferStart.Left, Top:=Target.Top, _
                Width:=rngTrefferStart.Width, Height:=rngTrefferStart.Height)
            shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
            shp.Fill.ForeColor.TintAndShade = 0.5
        End If
    End If
End Sub