VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

String mit Prüfziffer über Dialogeingabe erstellen

Gruppe

Allgemein

Bereich

Zeichenfolge

Thema

String mit Prüfziffer über Dialogeingabe erstellen

Problem

Nach Auswahl eines Landes aus einer ComboBox und der Eingabe einer 11-stelligen RinderCode-Nummer soll der komplette Code mit Länderkurzbezeichnung und Prüfziffer in einem LabelFeld angezeigt werden.

Lösung

Geben Sie den nachstehenden Code in das Klassenmodul der UserForm ein.




ClassModule: frmCode

Private Sub cboLaender_Change()
   If txtCode.TextLength = 11 Then
      Call txtCode_Change
   End If
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   ActiveCell.Value = lblCode.Caption
   Unload Me
End Sub

Private Sub txtCode_Change()
   Dim wks As Worksheet
   Dim iChar As Integer, iCode As Integer
   Dim sCode As String, sTmp As String
   If txtCode.TextLength = 0 Then
      lblCode.Caption = ""
      Exit Sub
   End If
   If Right(txtCode.Text, 1) Like "[0-9]" = False Then
      txtCode.Text = Left(txtCode.Text, Len(txtCode.Text) - 1)
   End If
   Set wks = ThisWorkbook.Worksheets("Länder")
   If txtCode.TextLength = 11 Then
      sCode = wks.Cells(cboLaender.ListIndex + 1, 3).Value
      sCode = sCode & txtCode.Text
      For iChar = 14 To 1 Step -2
         iCode = iCode + CInt(Mid(sCode, iChar, 1))
      Next iChar
      iCode = iCode * 3
      For iChar = 13 To 1 Step -2
         iCode = iCode + CInt(Mid(sCode, iChar, 1))
      Next iChar
      iCode = Fix(iCode / 10) * 10 + 10 - iCode
      sTmp = wks.Cells(cboLaender.ListIndex + 1, 2).Value & _
         " " & Mid(sCode, 4, 3) & "." & _
         Mid(sCode, 7, 4) & "." & _
         Mid(sCode, 11, 4) & "." & iCode
      If Right(sTmp, 2) = "10" Then
         sTmp = Left(sTmp, Len(sTmp) - 2) & "0"
      End If
      iCode = InStr(sTmp, " ") + 1
      Do Until Mid(sTmp, iCode, 1) <> "0"
         Mid(sTmp, iCode, 1) = "µ"
         iCode = iCode + 1
      Loop
      sTmp = WorksheetFunction.Substitute(sTmp, "µ", "")
      lblCode.Caption = sTmp
      cmdOK.SetFocus
   End If
End Sub

Private Sub UserForm_Initialize()
   cboLaender.List = ThisWorkbook.Worksheets("Länder") _
      .Range("A1").CurrentRegion.Columns(1).Value
   cboLaender.ListIndex = 0
End Sub

StandardModule: Modul1

Sub DialogAufruf()
   frmCode.Show
End Sub

    


Beiträge aus dem Excel-Forum zu den Themen Allgemein und Zeichenfolge