Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1788to1792
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
Text aus Zwischenablage in Textboxes
26.10.2020 17:16:07
Wolfgang
Hallo Zusammen,
den nachfolgenden Code erhielt ich vor geraumer Zeit hier aus dem Forum. Er läuft soweit auch wunderbar. Durch eine Programmänderung ergibt sich jetzt die Möglichkeit, gleichzeitig noch vorhandene Telefonnummern in die Zwischenablage zu kopieren. Im UF sollten diese, sofern realisierbar, in Textbox7 sowie TextBox8 erscheinen.
Bisher ging es in den Textboxes 1-6 um Adressdaten im folgenden Format:
Frau Müller, Maria
Berliner Weg 35
1200 Musterstadt
ließe sich der Code ergänzen, um nun die Telefonnummern noch erscheinen zu lassen?
Format:
+49 (2731) 12345
(Privat/ Dienstlich)
+49 (177) 456789
(Privat/ Dienstlich)
Hier wäre schön, wenn anstatt +49 direkt eine 0 vorangestellt würde und die Leerzeichen sowie die Klammerzeichen dazwischen gelöscht werden, so dass die Telefonnummer direkt der Reihe nach erscheint. Weiterhin soll das (Privat/Dienstlich) sowie Telefon/Skype Icon nicht übernommen werden.
Herzlichen Dank schon jetzt für die Rückmeldungen!
Viele Grüße - Wolfgang
  • 
    Private Sub CommandButton1_Click()
    Dim strText As String
    Dim avntValues As Variant, vntItem As Variant
    Dim ialngIndex As Long, lngIndex As Long
    Dim objClipBoard As DataObject
    On Error Resume Next 'Abfangen, wenn Zwischenablage leer
    Set objClipBoard = New DataObject
    Call objClipBoard.GetFromClipboard
    strText = objClipBoard.GetText
    Set objClipBoard = Nothing
    avntValues = Split(strText, vbCrLf)
    TextBox1.Text = Split(avntValues(2), " ")(0)
    For Each vntItem In Split(avntValues(2), " ")
    If Right$(vntItem, 1) = "," Then Exit For
    lngIndex = lngIndex + 1
    Next
    For ialngIndex = 1 To lngIndex
    TextBox2.Text = TextBox2.Text & Split(avntValues(2), " ")(ialngIndex) & " "
    Next
    TextBox2.Text = Replace$(TextBox2.Text, ",", vbNullString)
    TextBox2.Text = Trim$(TextBox2.Text)
    For ialngIndex = lngIndex + 1 To UBound(Split(avntValues(2), " "))
    TextBox3.Text = TextBox3.Text & Split(avntValues(2), " ")(ialngIndex) & " "
    Next
    TextBox3.Text = Trim$(TextBox3.Text)
    TextBox4.Text = avntValues(6)
    TextBox5.Text = Split(avntValues(10), " ")(0)
    For ialngIndex = 1 To UBound(Split(avntValues(10), " "))
    TextBox6.Text = TextBox6.Text & Split(avntValues(10), " ")(ialngIndex) & " "
    Next
    TextBox6.Text = Trim$(TextBox6.Text)
    End Sub
    

  • 9
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Text aus Zwischenablage in Textboxes
    26.10.2020 17:56:04
    volti
    Hallo Wolfgang,
    mit dieser Ergänzung sollte es passen.
    Ggf. sind die beiden Indexe 11 und 13 noch anzupassen, da ich den Code nicht testen konnte und diese Indexe so nicht prüfen kann.
    Code:
    [Cc]

    Sub Erweiterung() If UBound(avntValues) > 12 Then With textbox7 .Text = Replace(avntValues(11), "+49 ", "0") .Text = Replace(Replace(.Text, ")", ""), "(", "") .Text = Replace(.Text, " ", "") End With With textbox8 .Text = Replace(avntValues(13), "+49 ", "0") .Text = Replace(Replace(.Text, ")", ""), "(", "") .Text = Replace(.Text, " ", "") End With End If End Sub

    ____________
    viele Grüße 😊
    Karl-Heinz

    Anzeige
    AW: Text aus Zwischenablage in Textboxes
    27.10.2020 08:41:02
    Wolfgang
    Hallo Karl-Heinz,
    zunächst vielen Dank für Deine schnelle Rückmeldung und die Ergänzung des Codes. Ich habe die Ergänzungen soeben eingebaut - leider tut sich nichts. Wäre denkbar, mir vielleicht kurz die Funktionen des Codes zu erläutern, damit ich versuchen kann, evtl. über die wesentlichen Einstellungen ihn anzupassen sowie zu verstehen.
    Wofür steht z.B.
    
    If UBound(avntValues) > 12 Then
    
    sowie

    .Text = Replace(avntValues(11), "+49 ", "0")
    Du hattest ja schon geschrieben, dass die Indexe 11 und 13 evtl. angepasst werden müssten. Wie würde das funktionieren bzw. was bedeutet oder passiert bei Indexe?
    Ich danke schon jetzt recht herzlich für Deine erneute Rückmeldung.
    Viele Grüße - Wolfgang
    Anzeige
    AW: Text aus Zwischenablage in Textboxes
    27.10.2020 09:42:13
    volti
    Hallo Wolfgang,
    Deinem bisherigen Code habe ich (hoffentlich richtig) entnommen, dass der Text aus der Zwischenablage
    CRLF-getrennt in das Array avntValues geschrieben wird.
    Insgesamt hatte das Array wohl 11 Positionen (also Index 10, beginnend bei 0).
    Kommen jetzt noch vier Zeilen Telefonnummern dazu....
    Mit if Ubound(avntValues)>12 kann man prüfen, ob das Array mindestens 13 Positionen aufweist.
    Mit der Replace-Funktionen werden Teile der Rufnummer ersetzt. Du wolltest doch
    +49 (69) 34 55 66 nach 069345566 umsetzen, oder?
    Teste einfach mal mit
    debug.print ubound(avntValues) wieviele Positionen es sind und
    debug.print avntValues(x) an welcher Stelle sich die Rufnummern befinden (x=Nummer)
    viele Grüße
    Karl-Heinz
    Anzeige
    AW: Text aus Zwischenablage in Textboxes
    27.10.2020 13:06:01
    Wolfgang
    Hallo Karl-Heinz,
    nachdem ich nun klären konnte, wie debug.print anzuwenden ist (ich hoffe, ich habe es richtig verstanden), habe ich es getestet und bekomme bei debug.print ubound(avntValues) die Zahl 26 im Direktfenster angezeigt.
    Bei debug.print avntValues(x) bekomme ich nichts angezeigt. Mache ich da etwas falsch - müsste ggfs. das (x) entfernt werden?
    Danke schon wieder erneut. Gruß - Wolfgang
    upps - das variiert von 18 bis 26
    27.10.2020 13:21:58
    18
    Hallo Karl-Heinz,
    ich habe noch weiter versucht und getestet. Nun habe ich einen Datensatz erwischt, der enthielt lediglich einen Tel.-Nr. Satz - da wird mir nun bei debug.print ubound(avntValues) 18 angezeigt und offensichtlich bei zwei Tel.-Nr. die 26. - Bei debug.print avntValues(x)bekomme ich weiterhin nichts angezeigt. - Gruß - Wolfgang
    Anzeige
    AW: upps - das variiert von 18 bis 26
    27.10.2020 14:33:59
    18
    Hallo Wolfgang,
    bin nicht am Rechner, aber schon mal folgendes:
    Für das x solltest Du testeweise verschiedene Werte (Indexe) z.B. 10 oder 11 einsetzen, um zu sehen, wo da die Rufnummern sind.
    Aber wenn die Anzahl der Index-Anzahl unterschiedlich ist, kommen wir da nicht weiter. Da muss ich eindeutig wissen, wie der Inhalt der Zwischenablage aussieht und am besten auch die Beispielmappe
    VG KH
    anderer Ansatz - jeweils einzelner Code?
    27.10.2020 18:33:08
    Wolfgang
    Hallo Karl Heinz,
    ich habe noch am Dienstrechner weiter getestet, bin aber nicht so wirklich auf "einen grünen Zweig" gekommen. Mir kam dann die Überlegung, ob nicht für jede Textbox ein einzelner Code erstellt werden kann, der dann mit jeweils einer getrennten Schaltfläche die Daten aus der Zwischenablage einfügt bzw. vorab separiert? Wenn Du da evtl. noch eine Idee hättest? Vielen Dank schon jetzt wieder! - Gruß Wolfgang
    Format:
    +49 (2731) 12345
    (Privat/ Dienstlich)
    Anzeige
    AW: anderer Ansatz - jeweils einzelner Code?
    28.10.2020 10:02:47
    volti
    Hallo Wolfgang,
    die Idee ist immer die gleiche, egal ob die Felder mit einer Aktion oder alle einzeln gefüllt werden sollen.
    Teste einfach mit Debug.print avntValues(Nr) durch Einsetzen von Zahlen, bei welchem Index die besagten Rufnummern auftauchen und setze die so ermittelte Nummer in den von mir schon bereitgestellten code ein.
    Falls Du die Rufnmmern doch lieber einzeln übertragen möchtest, kannst Du das z.B. so machen:
    (Ggf. noch die Userform z.B. Userform1 vor die Textbox schreiben, s.Code)
    Code:
    [Cc]

    Private Sub CommandButton1_Click() 'Es wurde nur eine Position kopiert Dim strText As String, avntValues As Variant Dim objClipBoard As DataObject On Error Resume Next 'Abfangen, wenn Zwischenablage leer Set objClipBoard = New DataObject Call objClipBoard.GetFromClipboard strText = objClipBoard.GetText avntValues = Split(strText, vbCrLf) Set objClipBoard = Nothing With Userform1.Textbox7 .Text = Replace(avntValues(0), "+49 ", "0") .Text = Replace(Replace(.Text, ")", ""), "(", "") .Text = Replace(.Text, " ", "") End With End Sub

    ____________
    viele Grüße 😊
    Karl-Heinz

    Anzeige
    Danke - das klappt so super!!
    28.10.2020 11:50:02
    Wolfgang
    Hallo Karl-Heinz,
    vielen Dank für die erneute Rückmeldung und Anpassungen zu meinem Anliegen. Ich habe die Änderungen soweit eingebaut und konnte sie Dank Deiner Hinweise auch soweit modifizieren. Die Textboxes werden nun genauso befüllt, wie ich es mir vorstellte. Ich freue mich sehr - noch weniger Tipperei. Tausend Dank nochmals, viele Grüße und weiterhin alles Gute. - Wolfgang

    301 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige