QR-Code Eintrag verarbeiten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub QR_Eintrag() txt = ActiveSheet.Shapes("textbox 1").TextEffect.Text txt_Var = Split(txt, " ") Set gef = Range("A:A").Find(txt_Var(0)) If Not gef Is Nothing Then Cells(gef.Row, "B") = txt_Var(1) Cells(gef.Row, "C") = txt_Var(2) Cells(gef.Row, "G") = txt_Var(3) Else MsgBox txt_Var(0) & " nicht gefunden" End If Set gef = Nothing End Sub

Sub QR_Eintrag() If KeyCode = 13 Then txt = ActiveSheet.Shapes("TextBox2").TextEffect.Text txt_Var = Split(txt, " ") Set gef = Range("A:A").Find(txt_Var(0)) If Not gef Is Nothing Then Cells(gef.Row, "B") = txt_Var(1) Cells(gef.Row, "C") = txt_Var(2) Cells(gef.Row, "G") = txt_Var(3) Else MsgBox txt_Var(0) & " nicht gefunden" End If End If Set gef = Nothing End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'If Range("B2") = "" Then Range("B2") = "Schlüsselkasten"
'If Range("B3") = "" Then Range("B3") = "Schlüsselkasten"
'If Range("B4") = "" Then Range("B4") = "Schlüsselkasten"
'If Range("B5") = "" Then Range("B5") = "Schlüsselkasten"
'If Range("B6") = "" Then Range("B6") = "Schlüsselkasten"
'If Range("B7") = "" Then Range("B7") = "Schlüsselkasten"
'If Range("B8") = "" Then Range("B8") = "Schlüsselkasten"
'If Range("B9") = "" Then Range("B9") = "Schlüsselkasten"
'If Range("B10") = "" Then Range("B10") = "Schlüsselkasten"
'If Range("B11") = "" Then Range("B11") = "Schlüsselkasten"
'If Range("B12") = "" Then Range("B12") = "Schlüsselkasten"
'If Range("B13") = "" Then Range("B13") = "Schlüsselkasten"
'If Range("B14") = "" Then Range("B14") = "Schlüsselkasten"
Dim rng As Range, rng2 As Range, rng3 As Range

    Application.EnableEvents = False
    Set rng = Range("A:A").SpecialCells(xlCellTypeConstants)
    Set rng2 = Range("B:B").SpecialCells(xlCellTypeBlanks)
    Set rng3 = Application.Intersect(rng.Offset(0, 1), rng2)
    
    If Not rng3 Is Nothing Then rng3 = "Schlüsselkasten"
Application.EnableEvents = True
End Sub





Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim wks As Worksheet, Wert, Zelle As Range, Nach As Range, txt_Var As Variant

    

    If KeyCode > 13 Then Exit Sub

    Wert = Me.TextBox1.Value

    txt_Var = Split(Wert, " ")

    Set Zelle = Range("A:A").Find(txt_Var(0), LookIn:=xlValues, LookAt:=xlWhole)

    

    If Not Zelle Is Nothing Then

        Zelle.Offset(0, 1).ClearContents

        Zelle.Offset(0, 2).ClearContents

        Zelle.Offset(0, 6).ClearContents

    Else

        MsgBox Wert & " nicht gefunden"

    End If

    TextBox1.Value = ""

End Sub





Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim wks As Worksheet, Wert, Zelle As Range, Nach As Range, txt_Var As Variant

    

    If KeyCode > 13 Then Exit Sub

    Wert = Me.TextBox2.Value

    txt_Var = Split(Wert, " ")

    Set Zelle = Range("A:A").Find(txt_Var(0), LookIn:=xlValues, LookAt:=xlWhole)



    If Not Zelle Is Nothing Then

        Cells(Zelle.Row, "B") = txt_Var(1)

        Cells(Zelle.Row, "C") = txt_Var(2)

        Cells(Zelle.Row, "G") = txt_Var(3)

    Else

        MsgBox txt_Var(0) & " nicht gefunden"

    End If

    

    Set Zelle = Nothing

    TextBox2.Value = ""

End Sub

Code:

Option Explicit

Sub Test()
  Call QR_Code_Verarbeiten("681 MUSTERMANN Max 01.01.2023-01.02.2023")
End Sub

Sub QR_Code_Verarbeiten(sQR_Code As String)
' Match mit Error
  Dim vGefunden As Variant, sArr() As String
  
  With Sheets("Tabelle1")
     vGefunden = Application.Match(Left$(sQR_Code, 3), .Columns(1), 0)
     If Not IsError(vGefunden) Then
        sArr = Split(sQR_Code)
        .Cells(vGefunden, "B").Value = sArr(1)
        .Cells(vGefunden, "C").Value = sArr(2)
        .Cells(vGefunden, "G").Value = sArr(UBound(sArr))
     End If
  End With
End Sub

'ins Modul von Tabelle1 Private Sub TextBox2_LostFocus() QR_Eintrag End Sub 'das hier in ein allgemeines Modul Sub QR_Eintrag() Dim txt As String, txt_Var() As String, gef txt = ActiveSheet.TextBox2.Text txt_Var = Split(txt, " ") Set gef = Range("A:A").Find(txt_Var(0)) If Not gef Is Nothing Then Cells(gef.Row, "B") = txt_Var(1) Cells(gef.Row, "C") = txt_Var(2) Cells(gef.Row, "G") = txt_Var(3) Else MsgBox txt_Var(0) & " nicht gefunden" End If Set gef = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

QR-Code Eintrag verarbeiten

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread