CI-DESSOUS Copie du code écrit et pour lequel je demande de l'aide!
Dans le texte dela copie du code, 'en caractères gras', est indiqué mon problème à solutionner !
Code :
Private Sub CommandButton9_Click()
'Selection de la feuille de Calcul 1
Worksheets("Feuil1").Select
'Effacement des tables dans la feuille 2
Worksheets("Feuil1").TextBox1.Text = Clear
Dim TableDep As Integer
Dim RangTableSuivante As Integer
Dim DecriTable As String
Dim Table As Integer
Dim Compteur As Integer
Dim NombreLignesTable As Integer
Dim NumMaxiTable As Integer
Dim LigneDepartTable As Integer
Dim LigneFinTable As Integer
Dim LigneTable As Integer
Dim Message As String
'*****************************************************
'Tri par Numéros de table
' ELEVEMENT DE LA PROTECTION CODE
'Worksheets("Feuil1").Unprotect Password:="BJ/CROUZET"
Selection.AutoFilter
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C2:C500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
' Placement du curseur en cellule C500
Range("C500").Select
'Recherche la dernière cellule renseignée colonne des tables : C
Selection.End(xlUp).Select
'MsgBox ("cellule active table Numéro le plus élevé" & ActiveCell.Address)
'Mettre dans la variable des boucles le numéro le plus élevé du nombre de tables
NumMaxiTable = ActiveCell.Value
'MsgBox (" Numéro plus élevé de table, Cellule active :" & NumMaxiTable)
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
'Adresse de la cellule fictive
'MsgBox ("Adresse Cellule fictive Numéro Table" & ActiveCell.Address)
'Mise en variable de l'adresse de la cellule table fictive
RangTableFictive = ActiveCell.Row
'*********************************************************
'Placement ec cellule C2 Colonne des tables
Range("C2").Select
Table = 1 ' Numéro de la première table
Etiquette1:
'MsgBox ("Table :" & Table & " Compteur" & Compteur)
If Table = NumMaxiTable + 1 Then
'Effacement du numéro de table fictif placé sous le rang Maxi table
Cells(RangTableFictive, 3).Value = Clear
' REMISE DE LA PROTECTION CODE
'Worksheets("Feuil1").Protect Password:="BJ/CROUZET"
Exit Sub
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
End If
' Envoi sur Programme compte lignes de chaque table
GoSub CompteLigneTable
'MsgBox ("Table suivante :" & Table & " Compteur" & Compteur)
CompteLigneTable:
Compteur = 0
'TableDep contient le numéro de table de départ la boucle se faisant par une descente d'une ligne
TableDep = ActiveCell.Value
'Ligne de départ Table
LigneDepartTable = ActiveCell.Row
Do
'Descente à la cellule en dessous
ActiveCell.Offset(1).Select
Compteur = Compteur + 1
Table = ActiveCell.Value
'Nombre de lignes pour chaque table EN TENANT COMPTE QUE LE COMPTEUR EST SUR LA 1° LIGNE DE LA RABLE SUIVANTE --- donc Compteur -1
LigneFinTable = LigneDepartTable + Compteur - 1
' Pour le calcul du Nombres de lignes Table Le calcul doit prendre la ligne de la table suivante - la ligne de départ
NombreLignesTable = (LigneFinTable + 1) - LigneDepartTable
If Table = TableDep + 1 Then
'MsgBox ("Table départ en cours" & TableDep & " / " & " Table suivante" & Table)
' ATTENTION,NuméroTable en cours est la variable ( TableDep), puisque la boucle s'arrête sur la la ligne de la table en dessous
'DecriTable = "Numéro de la Table :" & TableDep & " - " & "Ligne de Départ Table :" & LigneDepartTable & " - " & "Ligne de fin de Table : " & LigneFinTable & " - " & "Nombre de lignes Table :" & NombreLignesTable
'MsgBox (DecriTable)
Dim Tableau(1 To 499)
For i = LigneDepartTable To LigneFinTable
Tableau(i) = Cells(i, 1).Value & " : " & Cells(i, 4).Value & " Personne (s) "
Next i
Message = ""
' Dans la Boucle suivante LigneFinTable correspond au numéro de la table suivante donc pour la bonne table modification en : LigneFinTable -1
For Boucle = LigneDepartTable To LigneFinTable
Message = Message & Tableau(Boucle) & vbLf
Next Boucle
'Else
'MsgBox ("ligne suivante de la même table N° " & Table & ": " & ActiveCell.Row)
End If ' ***de **** If Table = TableDep + 1 Then
Loop Until ActiveCell.Value = TableDep + 1
'MsgBox ("Table : " & TableDep & " /" & "Ligne Départ : " & LigneDepartTable & " /" & "Ligne fin :" & LigneFinTable & " /" & " Nombre Lignes Table : " & NombreLignesTable & " /" & "Nombre de Boucles effectuées : " & Boucle)
'MsgBox (Message)
'********************************************************************************************************************************************************************
'A PARTIR d'ici trouver la boucle qui va permettre d'inscrire les personnes de chaque table dans les Textbox correspondantes de la Feuille de calcul. ou d'un userfom
'********************************************************************************************************************************************************************
'Avec la boucle ci-dessous , les personnes s'affichent successivement dans leur table respective, dans l'userform.
'Mais chaque table apparaît successivement avec ses personnes affectées. (Voir 2 photos jointes).
'Le but est d'afficher dans l'userform toutes les tables avec leurs personnes respectives. ( Sur la feuille Excel, les Noms sont en colonne A _
'les Tables en colonne D et les personnes en colonne C
For j = TableDep To 5
UserForm3.Controls("TextBox" & (TableDep)) = Message
Next j
UserForm3.Show
GoTo Etiquette1
Return
End Sub
Dans le texte dela copie du code, 'en caractères gras', est indiqué mon problème à solutionner !
Code :
Private Sub CommandButton9_Click()
'Selection de la feuille de Calcul 1
Worksheets("Feuil1").Select
'Effacement des tables dans la feuille 2
Worksheets("Feuil1").TextBox1.Text = Clear
Dim TableDep As Integer
Dim RangTableSuivante As Integer
Dim DecriTable As String
Dim Table As Integer
Dim Compteur As Integer
Dim NombreLignesTable As Integer
Dim NumMaxiTable As Integer
Dim LigneDepartTable As Integer
Dim LigneFinTable As Integer
Dim LigneTable As Integer
Dim Message As String
'*****************************************************
'Tri par Numéros de table
' ELEVEMENT DE LA PROTECTION CODE
'Worksheets("Feuil1").Unprotect Password:="BJ/CROUZET"
Selection.AutoFilter
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C2:C500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
' Placement du curseur en cellule C500
Range("C500").Select
'Recherche la dernière cellule renseignée colonne des tables : C
Selection.End(xlUp).Select
'MsgBox ("cellule active table Numéro le plus élevé" & ActiveCell.Address)
'Mettre dans la variable des boucles le numéro le plus élevé du nombre de tables
NumMaxiTable = ActiveCell.Value
'MsgBox (" Numéro plus élevé de table, Cellule active :" & NumMaxiTable)
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
'Adresse de la cellule fictive
'MsgBox ("Adresse Cellule fictive Numéro Table" & ActiveCell.Address)
'Mise en variable de l'adresse de la cellule table fictive
RangTableFictive = ActiveCell.Row
'*********************************************************
'Placement ec cellule C2 Colonne des tables
Range("C2").Select
Table = 1 ' Numéro de la première table
Etiquette1:
'MsgBox ("Table :" & Table & " Compteur" & Compteur)
If Table = NumMaxiTable + 1 Then
'Effacement du numéro de table fictif placé sous le rang Maxi table
Cells(RangTableFictive, 3).Value = Clear
' REMISE DE LA PROTECTION CODE
'Worksheets("Feuil1").Protect Password:="BJ/CROUZET"
Exit Sub
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
End If
' Envoi sur Programme compte lignes de chaque table
GoSub CompteLigneTable
'MsgBox ("Table suivante :" & Table & " Compteur" & Compteur)
CompteLigneTable:
Compteur = 0
'TableDep contient le numéro de table de départ la boucle se faisant par une descente d'une ligne
TableDep = ActiveCell.Value
'Ligne de départ Table
LigneDepartTable = ActiveCell.Row
Do
'Descente à la cellule en dessous
ActiveCell.Offset(1).Select
Compteur = Compteur + 1
Table = ActiveCell.Value
'Nombre de lignes pour chaque table EN TENANT COMPTE QUE LE COMPTEUR EST SUR LA 1° LIGNE DE LA RABLE SUIVANTE --- donc Compteur -1
LigneFinTable = LigneDepartTable + Compteur - 1
' Pour le calcul du Nombres de lignes Table Le calcul doit prendre la ligne de la table suivante - la ligne de départ
NombreLignesTable = (LigneFinTable + 1) - LigneDepartTable
If Table = TableDep + 1 Then
'MsgBox ("Table départ en cours" & TableDep & " / " & " Table suivante" & Table)
' ATTENTION,NuméroTable en cours est la variable ( TableDep), puisque la boucle s'arrête sur la la ligne de la table en dessous
'DecriTable = "Numéro de la Table :" & TableDep & " - " & "Ligne de Départ Table :" & LigneDepartTable & " - " & "Ligne de fin de Table : " & LigneFinTable & " - " & "Nombre de lignes Table :" & NombreLignesTable
'MsgBox (DecriTable)
Dim Tableau(1 To 499)
For i = LigneDepartTable To LigneFinTable
Tableau(i) = Cells(i, 1).Value & " : " & Cells(i, 4).Value & " Personne (s) "
Next i
Message = ""
' Dans la Boucle suivante LigneFinTable correspond au numéro de la table suivante donc pour la bonne table modification en : LigneFinTable -1
For Boucle = LigneDepartTable To LigneFinTable
Message = Message & Tableau(Boucle) & vbLf
Next Boucle
'Else
'MsgBox ("ligne suivante de la même table N° " & Table & ": " & ActiveCell.Row)
End If ' ***de **** If Table = TableDep + 1 Then
Loop Until ActiveCell.Value = TableDep + 1
'MsgBox ("Table : " & TableDep & " /" & "Ligne Départ : " & LigneDepartTable & " /" & "Ligne fin :" & LigneFinTable & " /" & " Nombre Lignes Table : " & NombreLignesTable & " /" & "Nombre de Boucles effectuées : " & Boucle)
'MsgBox (Message)
'********************************************************************************************************************************************************************
'A PARTIR d'ici trouver la boucle qui va permettre d'inscrire les personnes de chaque table dans les Textbox correspondantes de la Feuille de calcul. ou d'un userfom
'********************************************************************************************************************************************************************
'Avec la boucle ci-dessous , les personnes s'affichent successivement dans leur table respective, dans l'userform.
'Mais chaque table apparaît successivement avec ses personnes affectées. (Voir 2 photos jointes).
'Le but est d'afficher dans l'userform toutes les tables avec leurs personnes respectives. ( Sur la feuille Excel, les Noms sont en colonne A _
'les Tables en colonne D et les personnes en colonne C
For j = TableDep To 5
UserForm3.Controls("TextBox" & (TableDep)) = Message
Next j
UserForm3.Show
GoTo Etiquette1
Return
End Sub
