Textbox mehrmals verwenden.

Forumthread: Textbox mehrmals verwenden.

Jockel

Hallo
ich habe eine Tabelle, da sind in der Spalte C ab Zeile 7 Daten drin. Weil die Datenmenge manchmal recht groß ist, wollte ich die Spalte C durchlaufen und in jede Zelle, wo Text drin ist (egal, wie viel) diesen in eine Textbox kopieren und die gefüllte Textbox nachhher dahin kopieren, wo der Text entnommen wurde.
Dannach noch die Zeile so hoch machen, dass die Textbos reinpasst.
Ich habe das mal so programmiert, dass es für die Zelle C7 funktioniert.
With Worksheets("Übersicht")
.TextBox1.ShapeRange.Left = .Range("C7").Left + 4
.TextBox1.ShapeRange.Top = .Range("C7").Top + 4
.TextBox1.ShapeRange.Width = .Range("C7").Width - 4
.TextBox1.Value = .Range("C7").Value
.Range("C7").Value = ""
.TextBox1.Font.Size = 11
.TextBox1.AutoSize = True
.Range("C7").RowHeight = .TextBox1.Height + 4
End With
Das funktioniert soweit. Nun das Problem:
Ich habe auf dem Tabellenblatt die benötigte Textbox einmal als "Textbox1" abgelegt. (Das ist ein Muster, da sie betimmte Formatierungen haben soll) Die soll zur verarbeitung der Daten verwendet werden. Wenn ich nun den Code einmal in C7 durchlaufen lasse, schnappt sich der Code die Textbox und verwendet sie für C7.
Wenn der Code nun weiter läuft und in C8 Daten in eine Textbox schreiben will, würde er die, von zuvor verwendete C7 verwenden. Das heist, das ursprüngliche Muster wird bin nach ganz unten durchgerreicht.
Nun meine Fragen dazu.
- wie kann ich den Code so verwenden, dass sich der Code von der Textbox1 nur eine KOPIE macht und diese verwendet. Sprich, das Muster Textbox1 soll immer für alle Zellen verfügbar sein.
- Wie bekomme ich das ganze in eine Schleife, damit die Spalte C komplett durchlaufen wird. Im Prinzip würde es da reichen, wenn ich immer nur prüfen, WENN NICHT LEER.
Hoffe, ich konnte alles gut erklären, sonst bitte fragen.
Danke mal
Jockel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Textbox mehrmals verwenden.

11.07.2011 10:50:17

Tino

Hallo,
ich habe es mal so unter xl2007 versucht,
die Werte für die Schleife müsstest Du noch einbauen
die habe ich nur mal so zum testen fest vergeben.

Sub Copy_TextBox()
Dim OrgTxTBox As Shape, CopyTxTBox As Shape
Dim n As Long, rng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    
    With Worksheets("Übersicht")
        Set OrgTxTBox = .Shapes("TextBox1")
        
        For n = 7 To 10 'Schleife 
            Set CopyTxTBox = OrgTxTBox.Duplicate
            Set rng = .Cells(n, 3)
                
                With CopyTxTBox
                    .Left = rng.Left + 4
                    .Top = rng.Top + 4
                    .Width = rng.Width - 4
                    
                    With .OLEFormat.Object.Object
                        .Value = rng.Value
                        .Font.Size = 11
                        .AutoSize = True
                    End With
                    
                    rng.RowHeight = .Height + 4
                End With
                
                rng.Value = ""
        Next n
    End With

    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Gruß Tino

Passt, noch eine kleine Bitte...

11.07.2011 12:19:53

Jockel

Hallo Tino,
Funktioniert soweit fehlerfrei, nur noch eine kleine Bitte:
da wo die Schleife losläuft
For n = 7 To 10 'Schleife
Set CopyTxTBox = OrgTxTBox.Duplicate
Set rng = .Cells(n, 3)
kannst Du da noch ein Prüfung rein machen, wenn die Zeilenanzahl des Textes in der Spalte B GRÖSSER ist, wie in C, dann soll der Code abbrechen und in der nachsten Zeile weiter machen, also so ungefähr
If .Cells(n, 2).LineCount > .Cells(n, 3).LineCount Then ABBRUCH
Das ist natürlich schrott, aber so ähnlich dachte ich es mir :-)
Danke
Gruß
Jockel

AW: Passt, noch eine kleine Bitte...

11.07.2011 12:37:21

Tino

Hallo,
müsste so gehen, allerdings nur für händig eingegebene Zeilenumbrüche nicht für automatische,
sonst müsstest Du Dir was anderes einfallen lassen.

Sub Copy_TextBox()
Dim OrgTxTBox As Shape, CopyTxTBox As Shape
Dim n As Long, rng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    
    With Worksheets("Übersicht")
        Set OrgTxTBox = .Shapes("TextBox1")
        
        For n = 7 To 10 'Schleife 
            Set rng = .Cells(n, 3)
            If Len(rng.Offset(0, -1).Text) - Len(Replace(rng.Offset(0, -1).Text, Chr(10), "")) > _
               Len(rng.Text) - Len(Replace(rng.Text, Chr(10), "")) Then Exit For
            
            Set CopyTxTBox = OrgTxTBox.Duplicate
                
                With CopyTxTBox
                    .Left = rng.Left + 4
                    .Top = rng.Top + 4
                    .Width = rng.Width - 4
                    
                    With .OLEFormat.Object.Object
                        .Value = rng.Value
                        .Font.Size = 11
                        .AutoSize = True
                    End With
                    
                    rng.RowHeight = .Height + 4
                End With
                
                rng.Value = ""
        Next n
    End With

    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Gruß Tino

AW: Passt, noch eine kleine Bitte...

11.07.2011 15:34:42

jockel

Hallo Tino,
Danke, das passt so. Damit komme ich klar.
Fűr den automatischen Umbruch werde ich mir noch was űberlegen.
Grusd
Jockel

Beliebteste Forumthreads (12 Monate)

Forumthread: Textbox mehrmals verwenden.

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread