Textfelder

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Frame TextBox MsgBox
Bild

Betrifft: Textfelder
von: Sebastian Herb
Geschrieben am: 19.08.2015 15:55:06

Hallo zusammen,
ich versuche ein Textfeld über VBA zu erstelln, was auch funktioniert. Leider ist aber der Text ausserhalb des Textfeldes.
Kann mir jemand erklären wieso bzw.wie ich das Problem vermeide?
Vielen Dank ;)

Sub Test_2()
w = 5
Sheets("Tabelle1").Activate
Dim objShp As Object
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = Sheets("Tabelle1").Cells(w, 4).Value
    With .TextFrame
      .AutoSize = msoTrue
      Selection.Characters.Text = Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
  End With
    
    
End Sub

Bild

Betrifft: AW: Textfelder
von: Michael
Geschrieben am: 19.08.2015 16:02:34
Hi Sebastian,
das Selection vor .Characters muß weg.
Irgendwo solltest Du noch abfragen, ob ein Textfeld dieses Namens bereits existiert, sonst wird "der Zugriff verweigert", wenn Du es erneut anlegst.
Schöne Grüße,

Bild

Betrifft: AW: Textfelder
von: Sebastian Herb
Geschrieben am: 20.08.2015 08:50:54
Hallo Michael,
vielen Dank! Das funktioniert schonmal. Kannst du mir noch sagen wie ich die Box positionieren kann?
Habe es wiefolgt funktioniert. Klappt auch, leider ist jedoch die Textbox dann leer ;(
Gerne würde ich die Zeile auch mit einer Variablen belegen z.B. z=2
--> Spalte (L) Zeile (z)...Ist das möglich ?
Viele Grüße,
Sebastian

Sub Test_1()
w = 5
Sheets("Tabelle1").Activate
Dim objShp As Object
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = w
    With .TextFrame
      .AutoSize = msoTrue
     .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & " " & Sheets("Tabelle1").Cells(w, _
 3).Value & " " & Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
  End With
ActiveSheet.TextBoxes(w).Select
ActiveSheet.TextBoxes(w).Top = Range("L2").Top
ActiveSheet.TextBoxes(w).Left = Range("L2").Left
End Sub


Bild

Betrifft: AW: Textfelder
von: Michael
Geschrieben am: 20.08.2015 14:02:35
Hi Sebastian,
da hast Du ja ein paar Verschlimmbesserungen eingebaut!
Also: mit .Name = w kannst Du einer Variablen, die einen Text erwartet, zwar einen Zahlenwert zuweisen; der wird dann automatisch in einen Text umgewandelt, so daß in .Name nicht die Zahl 5, sondern der Text "5" enthalten ist.
Nur wenn Du die TextBoxes(w) selektieren willst, nimmt Excel die 5. Textbox (sofern vorhanden) und nicht die mit dem Namen "5".
Gewöhne Dir bitte an, am Anfang des Codes "option explicit" zu schreiben, dann mußt Du nämlich Variablen sauber deklarieren und solch Gehuschel ist in vielen Fällen ausgeschlossen.
So geht's:

Option Explicit
Sub Test_1()
Dim w As Long
Dim nameTB As String
Dim objShp As Object
nameTB = "TB" & w
w = 5
Sheets("Tabelle1").Activate
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & " " _
                       & Sheets("Tabelle1").Cells(w, _
 3).Value & " " & Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L2").Top
    .Left = Range("L2").Left
  End With
'ActiveSheet.TextBoxes(nameTB).Select
'ActiveSheet.TextBoxes(nameTB).Top = Range("L2").Top
'ActiveSheet.TextBoxes(nameTB).Left = Range("L2").Left
End Sub
Schöne Grüße,
Michael

Bild

Betrifft: AW: Textfelder
von: Sebastian Herb
Geschrieben am: 21.08.2015 09:49:39
Hallo Michael,
bist der Beste! Das funktioniert einwandfrei!!! ;)
Ich habe jetzt noch versucht nachdem ich bereits Textfelder erstellt habe, diese wieder zu löschen und das ganze nochmal zu durchlaufen....also gegen aktuelle Daten auszutauschen...
Leider klappt es mit der Deklarierung wiedermal nicht...
With Sheets("Tabelle2")
ActiveSheet.TextBoxes(nameTB).Delete 'Hier würde ich gerne alle vorhandenen löschen
End With
Kannst du mir da nochmal behilflich sein ?
Viele Grüße,
Sebastian

Bild

Betrifft: AW: Textfelder
von: Michael
Geschrieben am: 21.08.2015 13:22:08
Hi Sebastian,
ich habe das jetzt direkt eingebaut:

Option Explicit
Sub Test_1()
Dim w As Long, z As Long
Dim nameTB As String
Dim objShp As Object
Dim shp As Shape
nameTB = "TB" & w
w = 5
z = 7
Sheets("Tabelle1").Activate
For Each shp In Shapes
  MsgBox shp.Name & " Typ: " & shp.Type
  If shp.Type = msoTextBox Then shp.Delete
Next
Stop
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & " " _
                       & Sheets("Tabelle1").Cells(w, _
 3).Value & " " & Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L" & z).Top
    .Left = Range("L" & z).Left
  End With
End Sub
Das Problem ist, daß Shapes alles Mögliche sein können, Bilder, Autoformen usw., und eben auch Textboxen. Es gibt eine vorgefertigte Konstante dafür, die den Wert 17 enthält, nämlich msoTextBox.
Setz mal spaßhalber ne Autoform ins Tabellenblatt, ein Quadrat oder einen Pfeil oder irgendwas, und laß das Makro laufen: Du bekommst alle Namen und Typen der Shapes angezeigt, und nur Textboxen werden gelöscht - allerdings ist die Löschung erst sichtbar, wenn das Makro durch ist bzw. beim stop anhält.
Happy Exceling,
Michael

Bild

Betrifft: AW: Textfelder
von: Sebastian Herb
Geschrieben am: 24.08.2015 11:05:46
Guten Morgen Michael,
vielen Dank für deine ausführliche Antwort. Das geht für mich schon zu tief in die Materie haha
Ich habe das ganze mal meinen Bedürfnissen angepasst, evtl. kannst du herauslesen was ich bezwecke.
Leider kommt immer wieder die Fehlermeldung, das "Shapes2 nicht definiert ist (siehe Screenshot)

Sub TEST_24082015()
Dim w As Long, z As Long, s As Long
Dim nameTB As String
Dim objShp As Object
Dim shp As Shape
nameTB = "TB" & w
w = 5
s = 2
z = 7
Do While Not s = 0
If Sheets("Tabelle1").Cells(w, 4).Value = "" Then
s = 0
Else
For Each shp In Shapes
  MsgBox shp.Name & " Typ: " & shp.Type
  If shp.Type = msoTextBox Then shp.Delete
Next
Stop
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & " " _
                       & Sheets("Tabelle1").Cells(w, _
 3).Value & " " & Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L" & z).Top
    .Left = Range("L" & z).Left
  End With
w = w + 1
z = z + 1
Loop
End Sub
Userbild

Bild

Betrifft: AW: Textfelder
von: Michael
Geschrieben am: 24.08.2015 15:01:27
Hi Sebastian,
das kann ich nicht nachvollziehen.
Bei mir kommt vielmehr der Fehler "loop ohne do", weil das End If direkt vor dem loop fehlt.
Ansonsten läuft das Makro durch.
Mir ist nur aufgefallen: wir weisen den Namen der Textbox zu, bevor wir w einen Wert (vorbelegt ist ja immer mit 0, sobald man ihn geDimt hat) zuweisen. D.h. insbesondere, wenn Du w hochzählst und weitere Textboxen anlegen willst, mußt Du sinngemäß schreiben:

w = w + 1
nameTB = "TB" & w
Geh doch mal den Code mit F8 durch (Du siehst dann den gerade aktuellen Wert von Variablen, wenn Du die Maus drüberhältst), vielleicht kannst Du dann nachvollziehen, wo es hakelt.
Schöne Grüße,
Michael

Bild

Betrifft: und "mit Zeile"
von: Michael
Geschrieben am: 20.08.2015 14:04:45


Option Explicit
Sub Test_1()
Dim w As Long, z As Long
Dim nameTB As String
Dim objShp As Object
nameTB = "TB" & w
w = 5
z = 7
Sheets("Tabelle1").Activate
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & " " _
                       & Sheets("Tabelle1").Cells(w, _
 3).Value & " " & Sheets("Tabelle1").Cells(w, 4).Value
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L" & z).Top
    .Left = Range("L" & z).Left
  End With
End Sub


Bild

Betrifft: AW: Textfelder
von: Sebastian Herb
Geschrieben am: 25.08.2015 13:04:34
Hi Michael,
mit dem Loop möchte ich bezwecken, das alle Zeilen auf "befüllt" oder "leer" geprüft werden.
Sobald eine Leere Zeile dabei ist, kann das Programm ja beendet werden, da ich keine leeren Textboxen benötige ;)
Option Explicit

Sub Stakeholder_Analyse()
Dim w As Long
Dim z As Long
Dim s As Long
Dim nameTB As String
Dim objShp As Object
w = 5
s = 2
z = 2
Do While Not s = 0
If Sheets("P2_Stakeholder").Cells(w, 4).Value = "" Then
s = 0
Else
nameTB = "TB" & w
Sheets("P2_Stakeholder_Analyse").Activate
Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("P2_Stakeholder").Cells(w, 2).Value & " " & Sheets(" _
P2_Stakeholder").Cells(w, 3) & " " & Sheets("P2_Stakeholder").Cells(w, 4)
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L" & z).Top
    .Left = Range("L" & z).Left
  End With
  End If
  w = w + 1
  z = z + 2
  
  Loop
  
End Sub


Bild

Betrifft: AW: Textfelder
von: Sebastian Herb
Geschrieben am: 25.08.2015 13:30:41
Anbei die Datei. Das Makro mit dem Namen "Löschen" ist das jenige, welches die Löschung der bereits vorhanden Textfelder veranlassen sollte bevor es neue erstellt.
Wohin darf ich dir dein Bier als kleines Dankeschön schicken ? ;)
Grüße aus Niederbayern,
Sebastian
https://www.herber.de/bbs/user/99820.xlsm

Bild

Betrifft: AW: Textfelder
von: Michael
Geschrieben am: 25.08.2015 19:23:09
Hi Sebastian,
ich hatte es mit X2000 erstellt und getestet, und da hat es funktioniert - kann es sein, daß Du nen Mac hast?
Jedenfalls war "Shapes" nicht bekannt (der markierte Begriff war in Deinem "Foto" oben leider nicht sichtbar), mit Sheets("Tabelle2").Shapes geht es dann doch.
Ich habe alles zusammen mal in Deinen Code verpackt ...

Option Explicit
Sub FunktioniertMitLoeschen()
Dim w As Long
Dim z As Long
Dim s As Long
Dim nameTB As String
Dim objShp As Object
Dim shp As Shape
w = 4
s = 2
z = 2
For Each shp In Sheets("Tabelle2").Shapes
  If shp.Type = msoTextBox Then shp.Delete
Next
' Stop
Do While Not s = 0
If Sheets("Tabelle1").Cells(w, 4).Value = "" Then
s = 0
Else
nameTB = "TB" & w
Sheets("Tabelle2").Activate
Set objShp = ActiveSheet.Shapes.AddTextbox _
  (msoTextOrientationHorizontal, 20#, 20, 0#, 0#)
With objShp
    .Name = nameTB
    With .TextFrame
      .AutoSize = msoTrue
      .Characters.Text = Sheets("Tabelle1").Cells(w, 2).Value & _
        " " & Sheets("Tabelle1").Cells(w, 3) & _
        " " & Sheets("Tabelle1").Cells(w, 4)
    End With
    .Fill.ForeColor.SchemeColor = 9
    .Top = Range("L" & z).Top
    .Left = Range("L" & z).Left
    ' neu, bei Bedarf wieder löschen oder anpassen
    .Height = 15
    .Width = 120
    ' neu, bei Bedarf wieder löschen oder anpassen
  End With
  End If
  w = w + 1
  z = z + 2
Loop
End Sub

... und so scheint es zu laufen.
Übrigens: option explicit darf nur *einmal* ganz am Anfang im Modul stehen.
Unter ana Maß geht amol goar nix, gell.
Schöne Grüße aus N,
Michael
P.S.: Nur zum Anzeigen aller Objekte:
Sub ShapesAnzeigen()
Dim shp As Shape
For Each shp In Sheets("Tabelle2").Shapes
MsgBox shp.Name & " Typ: " & shp.Type
shp.Select
Stop
Next

End Sub

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Textfelder"