ich habe da mal wieder eine Frage wo ich nicht weiter komme.
Mit dem unten stehenden Code erzeuge ich Ein TextFeld und wenn ich dieses nicht mehr benötige lösche ich es wieder was auch funktioniert, Eigendlich wollte ich noch vor dem Löschen des TextFeldes den Inhalt in die tabelle doku in die erste freie zelle in reihe B eintragen aber das funktioniert irgendwie nicht. fehler werden aber auch nicht angezeigt. Weiss jemand Hilfe.
Sub Nr_1()
Dim rngTopLeft As Range, rngBottomRight As Range
Dim dblTop#, dblLeft#, dblHeight#, dblWidth#
Dim myTextBox As TextBox
Set rngTopLeft = Range("A59")
dblTop = rngTopLeft.Top
dblLeft = rngTopLeft.Left
Set rngBottomRight = Range("A63")
dblHeight = rngBottomRight.Top + rngBottomRight.Height - dblTop
dblWidth = rngBottomRight.Left + rngBottomRight.Width - dblLeft
Set myTextBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
dblLeft, dblTop, dblWidth, dblHeight).OLEFormat.Object
myTextBox.Name = "myboxer_1"
myTextBox.Characters.Text = " Info - "
'myTextBox.ShapeRange.Fill.ForeColor.SchemeColor = 1
myTextBox.ShapeRange.Fill.ForeColor.RGB = RGB(252, 252, 252)
myTextBox.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 2, 0.45
myTextBox.Characters.Text = " Info - "
With myTextBox.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Standart"
.Size = 14
.ColorIndex = 11
End With
End Sub
Sub loesche_1()
Dim intErstLeereZeile As Long
Dim letzteZeile As Long
Dim myTextBox As TextBox
Set myTextBox = myboxer_1
Dim objDataObject As DataObject
Set objDataObject = New DataObject
objDataObject.SetText myboxer_1.Text
objDataObject.PutInClipboard
intErsteLeereZeile = Sheets("Doku").Cells(Rows.Count, 2).End(xlUp).Row + 1
Sheets("Doku").Cells(intErsteLeereZeile, 2).Value = myboxer_1.Text.Value
Set objDataObject = Nothing
ActiveSheet.Shapes("myboxer_1").Delete
End Sub
Grüße Fred