XL 2016 Ecrire une boucle pour afficher ensemble dans un userform, toutes ses textbox complétées par la boucle! Voir mon code et photos feuilles joints !

gaby.jvx

XLDnaute Nouveau
Le problème à résoudre :

'A son affichage l'userform3 affiche successivement chaque table (Textbox) avec ses réservants affectés.

'Il faut la fermer sur la croix pour qu'elle affiche la table suivante avec ses réservants affectés, mais elle efface alors la table précédente!

' LE BUT EST :
Lorsque l'userform3 s'affiche ,
qu'il affiche toutes les tables (Textbox) avec leurs réservants affectés et le nombre de personnes du réservant!


Photos jointes de la feuille de calcul avec en colonne "A" Réservant, Colonne "C" Tables,Colonne "D" Nombre de personnes du Réservant.

Après ces photos est joint le Code VBA pour lequel je demande de m'aider à résoudre leproblème indiqué ci-dessus!

Merci.

Image 1 pour Forum.jpg
Image 2 pour Forum.jpg



Private Sub CommandButton9_Click()

'Selection de la feuille de Calcul 1

Worksheets("Feuil1").Select



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

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: 'Placement sur la cellule de la table suivante

'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



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



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



'MsgBox ("Table suivante :" & Table & " Compteur" & Compteur)





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)


For j = TableDep To NumMaxiTable

UserForm3.Controls("TextBox" & (TableDep)) = Message

Next j



UserForm3.Show



GoTo Etiquette1





End Sub
 

gaby.jvx

XLDnaute Nouveau
Bonjour @gaby.jvx

Ce qui est bien c'est que l'on ne t'a pas forcé la main tu as trouvé tout seul et justement en parlant de tout seul je vais te laisser tout seul trouver la solution.... 🤣

Bonne chance

@Phil69970
Merci
Xdlnaute Barbatruc
Bonjour @gaby.jvx

Ce qui est bien c'est que l'on ne t'a pas forcé la main tu as trouvé tout seul et justement en parlant de tout seul je vais te laisser tout seul trouver la solution.... 🤣

Bonne chance

@Phil69970
 

Discussions similaires

Statistiques des forums

Discussions
300 907
Messages
1 988 363
Membres
210 125
dernier inscrit
manager2015