Anzeige
Archiv - Navigation
1592to1596
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

Textbox erstellen, umbenennen u.mit Zellbez.füllen

Textbox erstellen, umbenennen u.mit Zellbez.füllen
29.11.2017 21:59:33
Constantin
Hallo,
ich möchte TextBoxen erstellen, diese umbenennen (neue Bezeichnung aus einem Zellinhalt ableiten) und danach befüllen durch einen Formelbezug auf eine Zelle der gleichen Zeile.
In der beigefügten Mappe ist die Tabelle1 in den Spalten D (Werknr) und E (Text) befüllt. Nun möchte ich in Spalte G (für jede Werknr) zuerst eine TextBox in die Zelle einfügen. Danach sollen deren Name abgeändert werden (statt Textbox1 z.B. WNR4711). Zum Befüllen der TextBox soll eine Formel eingefügt werden mit Bezug auf Spalte E (der gleichen Zeile) und den Text übernehmen.
Leider gelang mir das Umbenennen nicht. Ein Ansatz ist der beigefügten Mappe zu entnehmen.

Die Datei https://www.herber.de/bbs/user/118001.xlsm wurde aus Datenschutzgründen gelöscht


Ich würde mich freuen, wenn jemand hierzu einen Tipp hätte.
Vielen Dank.
Grüße, Constantin

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textbox erstellen, umbenennen u.mit Zellbez.füllen
30.11.2017 11:32:25
Nepumuk
Hallo Constantin,
teste mal:
Public Sub neue_textbox()
    Dim rng As Range
    Dim tb As TextBox
    For Each rng In Range(Cells(6, 4), Cells(Rows.Count, 4).End(xlUp))
        With rng
            With .Offset(0, 3)
                Set tb = ActiveSheet.TextBoxes.Add(.Left, .Top, .Width, .Height)
            End With
            tb.Name = "Werknr " & .Text
            tb.Formula = "=" & .Offset(0, 1).Address
        End With
    Next
    Set tb = Nothing
End Sub

Gruß
Nepumuk
Anzeige
AW: Textbox erstellen, umbenennen u.mit Zellbez.füllen
30.11.2017 13:10:59
Nepumuk
Hallo Constantin,
vorher alle löschen geht so:
Public Sub neue_textbox()
    Dim rng As Range
    Dim tb As TextBox
    Call ActiveSheet.TextBoxes.Delete
    For Each rng In Range(Cells(6, 4), Cells(Rows.Count, 4).End(xlUp))
        With rng
            With .Offset(0, 3)
                Set tb = ActiveSheet.TextBoxes.Add(.Left, .Top, .Width, .Height)
            End With
            tb.Name = "Werknr " & .Text
            tb.Formula = "=" & .Offset(0, 1).Address
        End With
    Next
    Set tb = Nothing
End Sub

Gruß
Nepumuk
Anzeige
Textfelder erstellen, umbenennen und...
30.11.2017 11:40:16
Case
Hallo Constantin, :-)
... mit Text aus bestimmter Zelle befüllen (bezogen auf Deine Beispieldatei): ;-)
Option Explicit
Public Sub Main()
Dim objTextBox As TextBox
Dim shpShape As Shape
Dim lngTMP As Long
On Error GoTo Fin
Application.ScreenUpdating = False
With Tabelle1
For Each shpShape In .Shapes
If shpShape.TopLeftCell.Column = 7 Then
shpShape.Delete
End If
Next shpShape
For lngTMP = 6 To IIf(Len(.Cells(.Rows.Count, 5)), .Rows.Count, _
.Cells(.Rows.Count, 5).End(xlUp).Row)
Set objTextBox = .Shapes.AddTextbox(msoTextOrientationHorizontal, _
10, 10, 10, 10).OLEFormat.Object
With objTextBox
.Name = .Parent.Cells(lngTMP, 4).Value
.Left = .Parent.Cells(lngTMP, 7).Left
.Height = .Parent.Cells(lngTMP, 7).Height
.Top = .Parent.Cells(lngTMP, 7).Top
.Width = .Parent.Cells(lngTMP, 7).Width
.Text = "Werknr" & .Parent.Cells(lngTMP, 4).Value
End With
Next lngTMP
End With
Fin:
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Deine Datei zurück...
Servus
Case

Anzeige
Wer lesen kann...
30.11.2017 11:56:13
Case
Hallo, :-)
... ist klar im Vorteil. ;-)
Nepumuk hat's richtig, was Name und Inhalt angeht:
Option Explicit
Public Sub Main()
Dim objTextBox As TextBox
Dim shpShape As Shape
Dim lngTMP As Long
On Error GoTo Fin
Application.ScreenUpdating = False
With Tabelle1
For Each shpShape In .Shapes
If shpShape.TopLeftCell.Column = 7 Then
shpShape.Delete
End If
Next shpShape
For lngTMP = 6 To IIf(Len(.Cells(.Rows.Count, 5)), .Rows.Count, _
.Cells(.Rows.Count, 5).End(xlUp).Row)
Set objTextBox = .Shapes.AddTextbox(msoTextOrientationHorizontal, _
10, 10, 10, 10).OLEFormat.Object
With objTextBox
.Name = "Werknr" & .Parent.Cells(lngTMP, 4).Value
.Left = .Parent.Cells(lngTMP, 7).Left
.Height = .Parent.Cells(lngTMP, 7).Height
.Top = .Parent.Cells(lngTMP, 7).Top
.Width = .Parent.Cells(lngTMP, 7).Width
.Text = .Parent.Cells(lngTMP, 5).Value
End With
Next lngTMP
End With
Fin:
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Servus
Case

Anzeige
AW: Wer lesen kann...
30.11.2017 21:09:26
Constantin
Hallo Nepumuk,
vielen Dank für Deine Lösung. Funktioniert super!!! Du hast auch schon weitergedacht mit dem Löschen. Genau das wollte ich versuchen noch reinzubringen. Allerdings sollten nur jene TextBoxen in diesem Tabellenblatt gelöscht werden, die mit "Werknr" im Namen beginnen. Der Befehl "Call ActiveSheet.TextBoxes.Delete" ist für mich besonders interessant, da ich ein Unterprogramm gesucht (und nicht gefunden) habe. Aber wie funktioniert dieser Befehl ohne weiteren Code?
Auch Dank an Case für seine Lösung. Bringt mich ebenfalls auf gute Ideen! Tolle Unterstützung.
Vielleicht habt ihr noch eine Lösung für die Einschränkung beim Löschen(?)
Grüße, Constantin
Anzeige
AW: Wer lesen kann...
30.11.2017 21:25:07
Constantin
Hallo Nepumuk,
vielen Dank für Deine Lösung. Funktioniert super!!! Du hast auch schon weitergedacht mit dem Löschen. Genau das wollte ich versuchen noch reinzubringen. Allerdings sollten nur jene TextBoxen in diesem Tabellenblatt gelöscht werden, die mit "Werknr" im Namen beginnen. Der Befehl "Call ActiveSheet.TextBoxes.Delete" ist für mich besonders interessant, da ich ein Unterprogramm gesucht (und nicht gefunden) habe. Aber wie funktioniert dieser Befehl ohne weiteren Code?
Auch Dank an Case für seine Lösung. Bringt mich ebenfalls auf gute Ideen! Tolle Unterstützung.
Vielleicht habt ihr noch eine Lösung für die Einschränkung beim Löschen(?)
Grüße, Constantin
Anzeige
AW: perfekt
30.11.2017 21:45:42
Constantin
Hallo Nepumuk und Case,
hab's mit dem Programmteil von Case hinbekommen. Spalte 7 reicht eigentlich auch als Eingrenzung. Super.
Grüße und Dank, Constantin
For Each shpShape In .Shapes
If shpShape.TopLeftCell.Column = 7 Then
shpShape.Delete
End If
Next shpShape

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige