Forums - xlExe.com - gse-pro.com

Code : Tout sélectionner

Const entrees_decimales_permises = ".,0123456789" & vbCr & vbBack
Const Point = "."
Const Virgule = ","
Dim combo As String
Dim clavier As String
Dim comd4 As String
Dim pass As Boolean
Dim recherche_combo_1 As Boolean
Dim recherche_combo_2 As Boolean

Private CodeClair$, CodeBarre$

#If Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
Private Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#End If

Code : Tout sélectionner

 Sub Creer_CB128()
 Dim ligne As Long
 ligne = 2
 Dim CodeBarre$
 While Not IsEmpty(Cells(ligne, 1))
 Cells(ligne, 5).Select
 Call vérif_cbval
 CodeBarre$ = code128$(Cells(ligne, 5))
 Cells(ligne, 4) = CodeBarre$
 ligne = ligne + 1
 Wend
 End Sub

Code : Tout sélectionner

 Sub vérif_cbval()

 Dim code_val As Boolean
 code_val = False

 Select Case ActiveCell.Value
 Case "ÒE -Í7jÓ"
 code_val = True ' 1
 Case "ÒE 7Í7?Ó"
 code_val = True ' 2
 Case "ÒE AÍ7{Ó"
 code_val = True ' 3
 Case "ÒE KÍ7PÓ"
 code_val = True ' 4
 Case "ÒE UÍ7%Ó"
 code_val = True ' 5
 Case "ÒE _Í7aÓ"
 code_val = True ' 6
 Case "ÒE iÍ76Ó"
 code_val = True ' 7
 Case "ÒE sÍ7rÓ"
 code_val = True ' 8
 Case "ÒE }Í7GÓ"
 code_val = True ' 9
 Case "ÒE !#Í73Ó"
 code_val = True ' 10
 Case "ÒE " & Chr(34) & "#Í78Ó"
 code_val = True ' 20
 Case "ÒE ##Í7=Ó"
 code_val = True ' 30
 Case "ÒE $#Í7BÓ"
 code_val = True ' 40
 Case "ÒE %#Í7GÓ"
 code_val = True ' 50
 Case "ÒE &#Í7LÓ"
 code_val = True ' 60
 Case "ÒE '#Í7QÓ"
 code_val = True ' 70
 Case "ÒE (#Í7VÓ"
 code_val = True ' 80
 Case "ÒE )#Í7[Ó"
 code_val = True ' 90
 Case "ÒE *#Í7`Ó"
 code_val = True ' 100
 Case "ÒE 4#Í7+Ó"
 code_val = True ' 200
 Case "ÒE >#Í7]Ó"
 code_val = True ' 300
 Case "ÒE H#Í7(Ó"
 code_val = True ' 400
 Case "ÒE R#Í7ZÓ"
 code_val = True ' 500
 Case "ÒE \#Í7%Ó"
 code_val = True ' 600
 Case "ÒE f#Í7WÓ"
 code_val = True ' 700
 Case "ÒE p#Í7" & Chr(34) & "Ó"
 code_val = True ' 800
 Case "ÒE z#Í7TÓ"
 code_val = True ' 900
 Case "ÒE ! #Í72Ó"
 code_val = True ' 1000
 Case "ÒE & Chr(34) & #Í76Ó"
 code_val = True ' 2000
 Case "ÒE # #Í7:Ó"
 code_val = True ' 3000
 Case "ÒE $ #Í7>Ó"
 code_val = True ' 4000
 Case "ÒE % #Í7BÓ"
 code_val = True ' 5000
 Case "ÒE & #Í7FÓ"
 code_val = True ' 6000
 Case "ÒE ' #Í7JÓ"
 code_val = True ' 7000
 Case "ÒE ( #Í7NÓ"
 code_val = True ' 8000
 Case "ÒE ) #Í7RÓ"
 code_val = True ' 9000
 Case "ÒE * #Í7VÓ"
 code_val = True ' 10000
 Case "ÒE 4 #Í7~Ó"
 code_val = True ' 20000
 Case "ÒE > #Í7?Ó"
 code_val = True ' 30000
 Case "ÒE H #Í7gÓ"
 code_val = True ' 40000
 Case "ÒE R #Í7(Ó"
 code_val = True ' 50000
 Case "ÒE \ #Í7PÓ"
 code_val = True ' 60000
 Case "ÒE f #Í7xÓ"
 code_val = True ' 70000
 Case "ÒE p #Í79Ó"
 code_val = True ' 80000
 Case "ÒE z #Í7aÓ"
 code_val = True ' 90000
 Case "ÒE ! #Í71Ó"
 code_val = True ' 100000
 Case "ÒE & Chr(34) & #Í74Ó"
 code_val = True ' 200000
 Case "ÒE # #Í77Ó"
 code_val = True ' 300000
 Case "ÒE $ #Í7:Ó"
 code_val = True ' 400000
 Case "ÒE % #Í7=Ó"
 code_val = True ' 500000
 Case "ÒE & #Í7@Ó"
 code_val = True ' 600000
 Case "ÒE ' #Í7CÓ"
 code_val = True ' 700000
 Case "ÒE ( #Í7FÓ"
 code_val = True ' 800000
 Case "ÒE ) #Í7IÓ"
 code_val = True ' 900000
 End Select

 code_val_tot = code_val_tot + code_val


 End Sub

Code : Tout sélectionner

Public Function code128$(chaine$)

On Error Resume Next

  Dim i%, checksum&, mini%, dummy%, tableB As Boolean
  code128$ = ""
  If Len(chaine$) > 0 Then
    For i% = 1 To Len(chaine$)
      Select Case Asc(Mid$(chaine$, i%, 1))
      Case 32 To 126, 203
      Case Else
        i% = 0
        Exit For
      End Select
    Next
    code128$ = ""
    tableB = True
    If i% > 0 Then
      i% = 1
      Do While i% <= Len(chaine$)
        If tableB Then
          mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
          GoSub testnum
          If mini% < 0 Then
            If i% = 1 Then
              code128$ = Chr$(210)
            Else
              code128$ = code128$ & Chr$(204)
            End If
            tableB = False
          Else
            If i% = 1 Then code128$ = Chr$(209)
          End If
        End If
        If Not tableB Then
          mini% = 2
          GoSub testnum
          If mini% < 0 Then
            dummy% = Val(Mid$(chaine$, i%, 2))
            dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
            code128$ = code128$ & Chr$(dummy%)
            i% = i% + 2
          Else
            code128$ = code128$ & Chr$(205)
            tableB = True
          End If
        End If
        If tableB Then
          code128$ = code128$ & Mid$(chaine$, i%, 1)
          i% = i% + 1
        End If
      Loop
      For i% = 1 To Len(code128$)
        dummy% = Asc(Mid$(code128$, i%, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 105)
        If i% = 1 Then checksum& = dummy%
        checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
      Next
      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
      code128$ = code128$ & Chr$(checksum&) & Chr$(211)
    End If
  End If
  Exit Function
testnum:
  mini% = mini% - 1
  If i% + mini% <= Len(chaine$) Then
    Do While mini% >= 0
      If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
End Function