1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
|
Private Sub Siretemployeur_AfterUpdate()
On Error GoTo Siretemployeur_AfterUpdate_Error
Dim numerosaisi As String
Dim numerotest As Variant
Dim i As Integer
Dim j As Integer
Dim grille1(9, 0)
Dim grille2(18, 0)
Dim A As Variant
Dim a1 As Byte
Dim a2 As Byte
Dim atester As Single
Dim resultat As Variant
'initialisation des variables
i = 1
j = 1
numerosaisi = Me.ActiveControl
numerotest = Left(numerosaisi, 9)
atester = 0
'décomposition du SIREN dans grille1
Do Until (9 - i) = -1
grille1(i, 0) = Left(numerotest, 1)
'si rang impaire *1 si rang paire *2
Select Case (i)
Case 1, 3, 5, 7, 9
A = grille1(i, 0) * 1
Case 2, 4, 6, 8
A = grille1(i, 0) * 2
End Select
a1 = IIf(Len(A) = 2, Left(A, 1), 0)
a2 = IIf(Len(A) = 2, Right(A, 1), A)
'alimentation des resultats dans grille2
grille2(j, 0) = a1
grille2(j + 1, 0) = a2
j = j + 2
'on passe au digit suivant
numerotest = IIf((9 - i) > 0, Right(numerotest, (9 - i)), numerotest)
i = i + 1
Loop
'addition des digits de grille 2
For j = 1 To 18
atester = atester + grille2(j, 0)
Next j
resultat = atester Mod 10
'on teste le modulo 10
If resultat <> 0 Then
MsgBox "NUMERO SIREN INVALIDE", vbExclamation
Exit Sub
Else
MsgBox "NUMERO SIREN VALIDE", vbExclamation
Call controle_siretemployeur
End If
On Error GoTo 0
Exit Sub
Siretemployeur_AfterUpdate_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Siretemployeur_AfterUpdate "
End Sub
'--------------------------------------------------------------------------
Private Sub controle_siretemployeur()
On Error GoTo controle_siretemployeur_Error
Dim numerosaisi As String
Dim numerotest As Variant
Dim i As Integer
Dim j As Integer
Dim grille1(12, 0)
Dim grille2(26, 0)
Dim n As Byte
Dim A As Variant
Dim a1 As Byte
Dim a2 As Byte
Dim atester As Single
Dim resultat As Variant
'initialisation des variables
i = 0
j = 1
numerosaisi = Me.ActiveControl
numerotest = Left(numerosaisi, 13)
'conservation de la clef
n = Right(numerosaisi, 1)
atester = 0
'décomposition du SIRET dans grille1 avec premier digit en rang 0
Do Until (12 - i) = -1
grille1(i, 0) = Left(numerotest, 1)
'si rang impaire *1 si rang paire *2
Select Case (i)
Case 1, 3, 5, 7, 9, 11
A = grille1(i, 0) * 1
Case 0, 2, 4, 6, 8, 10, 12
A = grille1(i, 0) * 2
End Select
'décomposition en 2 digits
a1 = IIf(Len(A) = 2, Left(A, 1), 0)
a2 = IIf(Len(A) = 2, Right(A, 1), A)
'alimentation des resultats dans grille2
grille2(j, 0) = a1
grille2(j + 1, 0) = a2
j = j + 2
'on passe au digit suivant
numerotest = IIf((12 - i) > -1, Right(numerotest, (12 - i)), numerotest)
i = i + 1
Loop
'addition des digits de grille 2
For j = 1 To 26
atester = atester + grille2(j, 0)
Next j
'on ajoute la clef
atester = atester + n
resultat = atester Mod 10
'on teste le modulo 10
If resultat <> 0 Then
MsgBox "NUMERO SIRET INVALIDE", vbExclamation
Exit Sub
Else
MsgBox "NUMERO SIRET VALIDE", vbExclamation
End If
On Error GoTo 0
Exit Sub
controle_siretemployeur_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure controle_siretemployeur of Document VBA Form_F_TRANSIT DDTEFP ETABLISSEMENTS"
End Sub |
Partager