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
|
Private Sub Codage(OngletName As String, Lig As Single, Optional FinCode As Boolean = False, Optional NewCode As Boolean = False)
Do 'boucle ligne A
If Lig = 1 Then
LigneTab = LigneTab + 1
ReDim TabCode(LigneTab)
TabCode(LigneTab) = Cells(Lig, ColLig1).Value
LigneTab = 0
TabTmp = TabCode
ReDim TabCode(0)
End If 'Lig = 1
Do 'boucle ligne B
ColLig2 = ColLig2 + 1
If Cells(Lig + 1, ColLig2).Value = "" Then 'colonne -> limite = ""
'sauvegarde code
If FinCode Then
If NewCode Then
FinTabResult = UBound(TabResult)
ReDim Preserve TabResult(UBound(TabResult) + UBound(TabCode))
For n = 1 To UBound(TabCode)
TabResult(FinTabResult + n) = TabCode(n)
Next n
End If 'NewCode
If Lig + 1 = NombreDeLigne Then ' fin tmp
If LargeurCode = NombreDeLigne Then
'change de colonne ligne A
Lig = 1
ColLig1 = ColLig1 + 1
If Cells(Lig, ColLig1).Value = "" Then 'colonne -> limite = ""
'############# IMPASSE ??? #######################
'probleme de récursivité avec exit sub
Exit Sub 'sécurité (tmp)
Else
Call Codage("Code2", Lig)
End If 'limite A = ""
Else
'change de ligne ligne A
End If
Else
ReDim TabCode(0)
LigneTab = 0
Call Codage("Code2", Lig + 1, True)
End If 'fin tmp
End If 'FinCode
'aiguillage vers derniers element du code
If Lig + 1 = LargeurCode - 1 Then
TabTmp = TabCode
ReDim TabCode(0)
LigneTab = 0
Call Codage("Code2", Lig + 1, True, True)
'For n = 1 To UBound(TabTmp)
' LigneTab = LigneTab + 1
' ReDim Preserve TabCode(LigneTab)
' TabCode(LigneTab) = TabTmp(n) & Cells(Lig + 1, ColLig2).Value
'Next n
Else
TabTmp = TabCode
ReDim TabCode(0)
LigneTab = 0
Call Codage("Code2", Lig + 1)
Exit Do 'sécurité (tmp)
End If 'aiguillage
Else
For n = 1 To UBound(TabTmp)
LigneTab = LigneTab + 1
ReDim Preserve TabCode(LigneTab)
TabCode(LigneTab) = TabTmp(n) & Cells(Lig + 1, ColLig2).Value
Next n
If FinCode Then NewCode = True 'entrée vers sauvegarde code
End If 'limite B = ""
Loop 'ligne B
Loop 'Ligne A
End Sub |