Excel vba Shape an bestimmter Stelle im Text platzieren

[sharky51]

Hallo zusammen,

wieder einmal eine Frage an Euch Excel-Kenner.

Wie kann man ein Shape, hier ein kleiner Kreis (Ellipse), an einer bestimmten Stelle im Zelltext platziert werden?

Ich habe mal hier etwas experimentiert...das funktioniert auch. Aber ich muss mir einen abfummeln um die Position des Bubbles zu platzieren.
Geht das auch eleganter? ich denke da ev. diesen Bubble nach einem bestimmten Begriff und dann zwei Leerzeichen später einzufügen.
In diesem Beispiel soll nach dem Wort Modus dieser Shape eingefügt werden.


Hier mal mein Beispiel:

Code:

Sub Test_Shape_platzieren()
  Dim ws As Worksheet, rg As Range, shp As Shape
 
  Call Shape_loeschen
 
  Set ws = ThisWorkbook.ActiveSheet
  With ws
      Set rg = ws.Cells(51, 2)
     
      rg.Value = "Einstellungen: Auf ""Favoriten Modus      "" klicken und dann... hier kommt weiterer Text "
   
      Set shp = .Shapes.AddShape(msoShapeOval, rg.Left + 298, rg.Top + 5, _
        Width:=8, Height:=8)
      shp.Fill.ForeColor.SchemeColor = 5
     
      shp.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
      shp.Name = "Ellipse 1"
     
    End With
 
  Set rg = Nothing
  Set shp = Nothing
  Set ws = Nothing
End Sub

Habt Ihr mir da bitte einen Lösungsvorschlag?

[Kuwer]

Hallo Erich,

per temporärer TextBox z.B. so:

Sub Test_Shape_platzieren()
    Dim rg As Range, lngW As Long

    With ActiveSheet
      On Error Resume Next
      .Shapes("Ellipse 1").Delete
      On Error GoTo 0
      Set rg = .Cells(51, 2)
          
      With .TextBoxes.Add(rg.Left, rg.Top, rg.Width, rg.Height)
        .Font.Name = rg.Font.Name
        .Font.Size = rg.Font.Size
        .AutoSize = True
        .ShapeRange.TextFrame2.MarginLeft = 0
        .ShapeRange.TextFrame2.MarginRight = 0
        .Text = "Einstellungen: Auf ""Favoriten Modus"
        lngW = .Left + .Width + 5
        .Delete
      End With
        
      rg.Value = "Einstellungen: Auf ""Favoriten Modus      "" klicken und dann... hier kommt weiterer Text "
  
      With .Shapes.AddShape(msoShapeOval, lngW, rg.Top + 4, 8, 8)
        .Fill.ForeColor.SchemeColor = 5
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .Name = "Ellipse 1"
      End With
    End With
    Set rg = Nothing
End Sub

Gruß Uwe

[sharky51]

Hallo Uwe,

vielen Dank!

Ich habe jetzt den Text wie folgt abgeändert, heißt vor dem Schlüsselwort "Modus" kommt noch Text hinzu so dass sich der String verlängert.

Code:

.Text = "Einstellungen für diese Senderliste: Einen Sender wählen, dann auf ""Favoriten Modus"

Außerdem besteht die Zelladresse .Cells(51,2) aus mehreren verbundenen Zellen.

Mit diesen Änderungen hüpft der Bubble leider nicht an die Stelle hinter dem Ausdruck "Modus"

Wo ist da das Problem, bzw. wie kann man das so abändern, dass egal wie lang der String ist das Shape immer an der gewünschten Stelle platziert wird?

Vielleicht gibt es da noch eine Lösung.

[schauan]

Hallöchen,

erst mal hoffe ich, dass die Zeichenkette einzeilig ist?

Du kannst mit INSTR feststellen, an welcher Position Modus steht. Du kannst nun mehr oder weniger genau anhand der Position einen Faktor ermitteln und ausrechnen, wo das Oval hingehört. Das ist allerdings wegen der unterschiedlichen Buchstabenbreite auch wieder etwas ungenau.

Eine Alternative zur Positionsbestimmung, die ich auch schon verwendet habe, wäre das Einfügen des Textes in eine Textbox. Bei automatischer Anpassung bekommst Du hier einen Wert, der deutlich genauer ist

[sharky51]

Hallo André,

danke für den Beitrag.

Leider ist die Zeichenkette nicht einzeilig.

Werde mich mal weiter versuchen 

[Kuwer]

Hallo Erich,

ich verstehe es echt nicht, warum du nicht einfach (schon nach meiner Antwort) mal eine Beispieldatei hochlädst.
Nachdem André nun noch die Idee mit der TextBox ins Spiel brachte, sollte es doch lösbar sein. :05:

Gruß Uwe