VBA - Erste Textzeile aus Shape kopieren

[Mr.Invisible]

Hallo Zusammen,

in der Internetrecherche konnte ich dazu leider keine Lösung finden.

In meiner Arbeitsmappe habe ich ein Rectangle-Shape ("WKA_1"), das mit 2 Zeilen Text gefüllt ist. Durch einen Button soll nun die zweite Zeile im Shape verändert werden, die erste Zeile soll so bleiben wie sie ist.

Mein Gedanke war es die erste Zeile einfach zu kopieren und diese dann mit der veränderten zweiten Zeile wieder einzufügen.

Ich hoffe jemand kann mir helfen wie ich nur die erste Zeile meines Shapes kopieren kann.

Code:

Private Sub CommandButton1_Click()
    Dim Sh As Shape
    Dim Headline As String

    Set Sh = ActiveSheet.Shapes("WKA_1")
    
    ' Hier weiß ich nicht mehr weiter:
    ' Erste Zeile kopieren:
    Headline = Sh.TextFrame.Characters.Text      ' Kopiert mir den ganzen Text

    ' Zeile eins und zwei einfügen:
    Sh.TextFrame.Characters.Text = Headline & vbCrLf & "Fortschrittsgrad: " & Watch_Workpackage.Label57 & "%"

End Sub

[Der Steuerfuzzi]

Hallo,

teile den Text doch auf (z. B. mit Left und Instr) und bastel ihn wieder neu zusammen.

[Der Steuerfuzzi]

Hier noch eine Alternative:

Code:

Private Sub CommandButton1_Click()
    Dim Sh As Shape
    Dim Headline As String

    Set Sh = ActiveSheet.Shapes("WKA_1")
    
    ' Hier weiß ich nicht mehr weiter:
    ' Erste Zeile kopieren:
    Headline = Sh.TextFrame.Characters.Text      ' Kopiert mir den ganzen Text

    ' Zeile eins und zwei einfügen:
    Sh.TextFrame.Characters.Text = Split(Headline, vbLf)(0) & vbLf & "Fortschrittsgrad: " & Watch_Workpackage.Label57 & "%"

End Sub

[Mr.Invisible]

Hier noch eine Alternative:

DU BIST MEIN HELD  :15: