Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Textfelder

Textfelder
19.08.2015 15:55:06
Sebastian
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

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textfelder
19.08.2015 16:02:34
Michael
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,

AW: Textfelder
20.08.2015 08:50:54
Sebastian
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

Anzeige
AW: Textfelder
20.08.2015 14:02:35
Michael
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

Anzeige
AW: Textfelder
21.08.2015 09:49:39
Sebastian
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

AW: Textfelder
21.08.2015 13:22:08
Michael
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

Anzeige
AW: Textfelder
24.08.2015 11:05:46
Sebastian
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

Anzeige
AW: Textfelder
24.08.2015 15:01:27
Michael
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

Anzeige
und "mit Zeile"
20.08.2015 14:04:45
Michael

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

Anzeige
AW: Textfelder
25.08.2015 13:04:34
Sebastian
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

Anzeige
AW: Textfelder
25.08.2015 13:30:41
Sebastian
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

AW: Textfelder
25.08.2015 19:23:09
Michael
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige