XL 2016 Définir Boucle pour afficher plusieurs tableaux dans des textbox sur une userform (ou sur une feuille Excel)

gaby.jvx

XLDnaute Nouveau
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
 

Pièces jointes

  • Image 1 pour Forum.jpg
    Image 1 pour Forum.jpg
    70.6 KB · Affichages: 37
  • Image 2 pour Forum.jpg
    Image 2 pour Forum.jpg
    71.2 KB · Affichages: 36

Phil69970

XLDnaute Barbatruc
Bonjour @gaby.jvx

Quelques remarques :
Voir la charte le § 1.3 et ne pas oublier le § 2.5 ;)
De plus ne pas oublier de mettre le code entre les balises
1650993708222.png


Bonne chance !!!!

@Phil69970
 

Eric C

XLDnaute Barbatruc
Bonsoir le forum
Bonsoir gaby.jvx, bonsoir Philippe

Pour ma part (pas trop pro du Vba), je ne cherche même pas à comprendre tant il y a de lignes à ingurgiter (je sais je deviens fainéant en vieillissant... Lorsque je lis un bon livre, il m'arrive de revenir à un passage du chapitre lu parce que j'ai perdu le fil ... alors dans les codes ..... :(). Un fichier (ça encore je "regarde" à mes risques & périls car on ne sais jamais...) mais des images Jpg..... Heureusement qu'ils y a des membres plus patients que moi sur ce forum et je les en remercie.
Un effort ...merci.
Bonne soirée à toutes & à tous.
@+ Eric c
 

gaby.jvx

XLDnaute Nouveau
Bonjour le fil

Le problème se complique car en plus il y a un problème de ..... vu 🤣🤣🤣

Bonne chance (bis)

@Phil69970
BONJOUR

En tous cas

Je n'ai fait qu'essayer de mettre ma demande d'aide en conformité avec les réflexions de certains membres : sur la présentation de la demande d'aide.

Ceci pour faciliter son éventuelle exploitation par des membres soucieux plus de l'entraide des projets, que de qualifer les autres membres d'impolis, par exemple.

Je suis quelqu'un de poli et respectueux de chacun... et presente mes excuses et regrets au contri... de n'avoir pas eu de bonjour...

Merci en tous cas à celui qui comme moi n'a qu'un souci .... s'entraider.

Bonne journée à ceux qui me liront .
 

Discussions similaires

Statistiques des forums

Discussions
314 729
Messages
2 112 268
Membres
111 481
dernier inscrit
zrk