Ecrire une boucle pour afficher dans un userform, toutes ses textbox
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.
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 SubBonjour,
Fournir le classeur SVP
A+
Bonjour,
Voici le fichier pour lequel l'aide est demandé sur le bouton "Plan de table sur Userform.
Merci encore , si vous pouvez m'aider !
Gaby.JVX
Autre amélioration prévu ensuite sur ce projet :
J'aimerai aussi pouvoir imprimer ensuite ce plan de table réalisé sur un Userform... mais il sera trop grand pour une salle qui doit compter une quarantaine de tables.
L'impression est alors impossible (sur plusieurs format A4 assemblables)... A moins que vous connaissez une solution en VBA !
J'avais pensé aussi faire le plan sur une autre feuille excel du classeur, plus facilement imprimable, mais je ne vois pas comment faire!
Fournir le mot de passe ou un fichier sans mot de passe...
Sorry... Pas vu : l'était un peu caché !
A+
Pour l'instant je ne vois pas trop ce que vous voulez faire :
Effectivement un UserForm sera peu pratique : Les capacités d'impression sont très succintes : Pas de mise en forme ni de zone d'impression paramétrable.
Il me semble qu'on est condamné à faire un plan sur feuille.
De plus un plan de table me semble peu approprié sauf à préciser un peu votre pensée...
Habituellement on fait un plan de salle en indiquant le nombre de places disponibles à chaque tables. Ensuite on affecte chaque groupe à une table en fonction du nombre de participants à ce groupe. On ne va pas mettre un groupe de 3 personnes à une table de 2 ni à une table de 6...
Mais après une fois affectés à une table les gens se placent bien comme ils veulent, les frileux à coté du radiateur, les visuels face à a salle ou à coté de la fenêtre... mélà je ne comprends pas ce que vous envisagez
Précisez. et le cas échéant indiquez pour chaque table le N° de table et la capacité possible. Après si vous voulez faire un plan de salle ça sera pas sorcier...
A+
On peut limiter le nombre de places par table à 4...
mais cela ne paraît pas indispensable !
Bonjour
Si vous regardez l'affichage des textbox( qui correspondent chacune à une table ) en actionnant le bouton plan de tables, dans un userform3.
Le problème est leur affichage par l'userform3, comme je l'ai indiqué, de manière successive, textbox1, puis le 2 en effaçant le précédent de l'affichage et ainsi de suite.
Le but est de les afficher les 5 textbox des 5 tables avec pour chacune leurs personnes par table.
Pour les numéros de table dans un userform un label "table n° x pour chaque table est possible.
L'impression étant compliquée pour un Userform, un plan sur feuille de calcul est préférable en effet car on peut sélectionner la partie de la feuille ou il se trouve pour l'imprimer.
(Pour le moment je me suis limité pour la programmation à 5 tables pour faciliter le travail !)
Si vous regardez dans le bas de la feuille de calcul ...
vers les lignes 505 et dessous :
J'ai déjà dessiné un plan de table avec des textbox...
Le problème est d'y envoyer les données (Réservant et son nombre de personnes sur chaque table, par la programmation du bouton "plan de tables".
Chaque table est une textbox !
vous me dites si c'est envisageable... en modifiant dans le code du bouton "plan de tables" la partie où pour le moment il y a juste un affichage dans un userform3 provisoire.
Bien sur le souci reste l'affichage en même temps de toutes les tables (textbox) complétées avec noms des Réservants et pour chacun d'eux le nombre de personnes sur une même table. L'emplacement des personnes aux tables n'est pas désigné est resté libre pour chacune d'elle.
On peut en effet mettre plusieurs reservants sur une même table. La limite du nombre de personnes par table est contrôlée par l'utilisateur en utilisant les autres boutons de la feuille qui lui servent à contrôler le nombre de personnes qu'il veut mettre par table. Cela permet de conserver une souplesse pour chaque évènement avec des tables plus ou moins grandes.
Ce serait mieux de modifier cette partie du Code du bouton "Plan de tables "pour un affichage dans le plan dessiné en bas de la feuille de calcul pour ensuite pouvoir mieux l'imprimer.
Si une autre solution de dessin de plan de table avec la programmation du bouton est possible... je m'en remets à vous pour m'aider à la concevoir.
En vous remerciant pour votre dévouement je vous souhaite un très bon week-end !
gaby.jvx
(gaby.jvx@free.fr )
Bonjour,
T'es un petit cachotier !
Cette macro te remplira les TextBox en bas de la feuille.
Une seule condition, il doit y avoir autant de TextBox que de N° dans la colonne 3. Sinon les TextBox manquants sont ignorés...
Sub Galopin()
Dim Arr, S$, i%, k%, iLR%, Obj As OLEObject
iLR = Cells(1).End(xlDown).Row
Arr = Range(Cells(2, 1), Cells(iLR, 3)).Value
k = 1
On Error GoTo GESTERR
For i = 1 To UBound(Arr)
If k <> Arr(i, 3) Then
Set Obj = WsL.OLEObjects("TextBox" & k)
S = Left(S, Len(S) - 1)
Obj.Object.Value = S
S = ""
k = Arr(i, 3)
S = S & Arr(i, 1) & vbCrLf
Else
k = Arr(i, 3)
S = S & Arr(i, 1) & vbCrLf
End If
Next
Set Obj = WsL.OLEObjects("TextBox" & k)
Obj.Object.Value = Left(S, Len(S) - 1)
Exit Sub
GESTERR:
Resume Next
End SubNota : Il n'est fait aucune vérification sur le nombre de convives par table. Ce problème est censé résolu dès le départ...
Important : Tous les TextBox doivent avoir leur propriété
EnterKeyBehavior =True
et
Multiline = True
EDIT :
Variante avec le nombre de personnes (s'il est supérieur à 1)
Sub Galopin2()
Dim Arr, S$, SS$, i%, k%, iLR%, Obj As OLEObject
iLR = Cells(1).End(xlDown).Row
Arr = Range(Cells(2, 1), Cells(iLR, 4)).Value
k = 1
On Error GoTo GESTERR
For i = 1 To UBound(Arr)
SS = ""
If k <> Arr(i, 3) Then
Set Obj = WsL.OLEObjects("TextBox" & k)
S = Left(S, Len(S) - 1)
Obj.Object.Value = S
S = ""
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
Else
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
End If
Next
Set Obj = WsL.OLEObjects("TextBox" & k)
Obj.Object.Value = Left(S, Len(S) - 1)
Exit Sub
GESTERR:
Resume Next
End SubA+
Bonjour Galopin 01
Merci pour votre réponse rapide.
Je vais l'essayer.
Mais je crains d'avoir un problème ayant laissé tomber pour éditer le plan de table ,
l'userform ..........pour la feuille de calcul. (En prévision de réussir son impression complète).
Je vous fais parvenir mon programme que j'ai modifié entre temps.
J'ai fait le plan de table sur la feuille de calcul sous le tableau de rentrée des données par l'utilisateur.
Il se trouve desssiné sur les lignes 504 à 535.
Le programme réécrit pour le bouton "Plan de table" écrit bien maintenant dans toutes les tables ( un Textbox par table, sur la feuille , 34 tables sur le plan).
Et l'impression du plan de table est ainsi parfaite. ( Testez , vous verrez).
Le souci restant est que chaque textbox de 1 à 34 donc pour les tables de 1 à 34 du plan imprime sur l'ensemble des textbox 1 à 34 :
les données ( Réservant colonne A, et Nombre de personnes colonne D de chaque réservant) de la dernière table saisie par l'utilisaeur (Donc ici la table 5).
Le but est évidemment que pour chaque table (Textbox) de 1 à 34, les données correspondantes de chaque table ( 1 ou plusieurs réservants et leur nombre de personnes respectives) soient inscrit dans chaque bonne table (TextBox) ! ( En correspondance avec les données de la feuille).
J'ai tenté d'être le plus clair possible... pas toujours facile.
Pouvez-vous regarder ce fichier que je vous envois en pièce jointe, et voir la correction à apporter à la programmation du bouton "Plan de Table".
Merci encore pour votre dévouement et votre compétence d'expert.
gaby.jvx
Re bonjour Galopin 01
Il y avait des erreurs dans le programme précédemment envoyé.
(Au niveau de la réinitialisation des textbox au lancement du bouton "plan de tables".
Je les ai rectifiées.
Ci joint le programme , pour votre aide comme demandé précédemment.
Encore merci.
gaby.jvx
Je ne me suis pas occupé des UserForm : Je pense que ce n'est pas adapté à la situation.
La macro que je vous ai fourni répond à votre demande : Remplacez seulement les 2 WSL par Worksheets("Feuil1") et ça marchera impeccable sous réserve que le N° du TextBox corresponde au N+ de table...
Je n'ai indiqué le nombre de personne que s'il est supérieur à 1.
Je ne me suis pas occupé de vos autres macros. Je pense que vous savez faire. Mais sinon demandez et je regarderai...
A+
Bonjour
j'ai essayé votre code. en l'intégrant dans la commande "Plan de table"
Peut-être l'ai je mal copié ou modifié dans le codage du bouton "plan de table"
je vous envois une copie du fichier pour que vous corrigiez ce que j'ai du mal faire, car cela ne fonctionne pas.
Les textbox du plan (sur les lignes 504 à 535) ne sont pas renseignées!
Dans mon fichier précédemment envoyé, en le testant, vous verrez que ma copie des données de la dernière table (donc ici 5, puisque 5 tables saisies seulement)
se fait dans toutes les textboxs, tables.
Il semble que ma boucle "do loop" va jusqu'à la dernière table (donc ici la 5) sans faire d'arrêt pour chaque table, pour mettre dans la variable "Message", ses données. Ma variable Message a donc en données que celles de la dernière table 5.
Ce qui fait que ces données de la dernière table 5 sont mises par ma boucle "for" dans chacune des 34 textbox tables .
Merci encore
Bon week-end
gaby.jvx
Je n'ai pas de problème, j'ai rajouté des lignes pour faire 15 tables et elles s'affichent correctement.
A+
Bonsoir Galopin 01,
Merci pour la programmation du bouton « Plan de Table »
Cela fonctionne impeccable pour compléter jusqu’un plan de 36 tables, mais il faut pour que cela fonctionnne que ma feuille ne soit pas verrouillée!
Lorsque la feuille est verrouillée le bouton ne fonctionne pas!
JE VOUS SOLLICITE ENCORE UNE FOIS POUR CORRIGER CE DERNIER SOUCI !
En effet je protège ma feuille pour éviter que l’utilisateur supprime des formules mises dans certaines cellules ou colonnes.
Tous les boutons de commande (Contrôle activeX) de la feuille ont dans leur codes les mêmes lignes de déverrouillage en début de fonction et de reverrouillage de la feuille en fin de fonction. Cela fonctionne sans problème!
Y a-t-il une programmation particulière à faire pour ce bouton "Plan de table", pour qu'il fonctionne sur une feuille verrouillée!
J’ai copié votre code dans le bouton de commande « Plan de Table » et ai ajouté simplement les lignes de déverrouillage et reverrouilage !
Merci
Gaby.jvx
Voici le code :
Private Sub CommandButton8_Click()
'Plan Tables
'Enlèvement verrouillage code
Worksheets("Feuil1").Unprotect Password:="******"
Dim Arr, S$, SS$, i%, k%, iLR%, Obj As OLEObject
iLR = Cells(1).End(xlDown).Row
Arr = Range(Cells(2, 1), Cells(iLR, 4)).Value
k = 1
On Error GoTo GESTERR
For i = 1 To UBound(Arr)
SS = ""
If k <> Arr(i, 3) Then
Set Obj = Worksheets("Feuil1").OLEObjects("TextBox" & k)
S = Left(S, Len(S) - 1)
Obj.Object.Value = S
S = ""
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
Else
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
End If
Next
Set Obj = Worksheets("Feuil1").OLEObjects("TextBox" & k)
Obj.Object.Value = Left(S, Len(S) - 1)
Exit Sub
GESTERR:
Resume Next
'Remise verrouillage code
Worksheets("Feuil1").Protect Password:="******"
End Sub
bonsoir,
Pas besoin de déprotéger - reprotéger...
C'est très simple :
Sub Galopin2()
Dim Arr, S$, SS$, i%, k%, iLR%, Obj As OLEObject
Worksheets("Feuil1").Protect Password:="Galopin", UserInterfaceOnly:=True
iLR = Cells(1).End(xlDown).Row
'Le reste sans changementA+
Bonjour Galopin
D'abord merci encore pour votre aide précieuse.
J’ai ajouté du code pour effacer à chaque lancement du bouton « Plan de Table » les valeurs précédentes de chaque TextBox (table dans le plan de table).
Je me suite ensuite aperçu d’une anomalie de fonctionnement :
Si les réservants sont classés par ordre de leur numéro de table, le plan de table sort exact, avec les bons noms de réservants et nombre de personnes .
Si les réservants sont en désordre comme au fur et à mesure de leur inscription sur la feuille, ou même classés par ordre alphabétique à l’aide du bouton de « classement par ordre alphabétique », l’action sur le bouton « Plan de Table » sort un plan de table erroné !
Ainsi si je classe les réservants par ordre de leur numéro de table à l’aide du bouton de « classement par numéro de table » , avant d’actionner le bouton « Plan de table » , le plan de tables sort exact ! (Bons numéros de tables avec les bons noms de réservants et nombre de personnes
Est-il possible de modifier le code du « Bouton Plan de Table » pour pallier cette anomalie !
Merci beaucoup.
Pour votre dévouement expert.
gaby.jvx
Private Sub CommandButton8_Click()
'Plan Tables
'Effacement des anciennes valeurs des textBoxs (Tables)
For Each oObjet In Me.OLEObjects
' TextBox
If TypeOf oObjet.Object Is msforms.TextBox Then
oObjet.Object.Value = ""
End If
Next oObjet
‘Place sur la cellule A520 pour afficher le Plan de Tables.
Range("A520").Select
Dim Arr, S$, SS$, i%, k%, iLR%, Obj As OLEObject
'Lignes enlevant la protection juste durant la fonction
Worksheets("Feuil1").Protect Password:="*****", UserInterfaceOnly:=True
iLR = Cells(1).End(xlDown).Row
'Fonction pour créer le plan de tables
iLR = Cells(1).End(xlDown).Row
Arr = Range(Cells(2, 1), Cells(iLR, 4)).Value
k = 1
On Error GoTo GESTERR
For i = 1 To UBound(Arr)
SS = ""
If k <> Arr(i, 3) Then
Set Obj = Worksheets("Feuil1").OLEObjects("TextBox" & k)
S = Left(S, Len(S) - 1)
Obj.Object.Value = S
S = ""
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
Else
k = Arr(i, 3)
SS = IIf(Arr(i, 4) > 1, " (" & Arr(i, 4) & ")", "")
S = S & Arr(i, 1) & SS & vbCrLf
End If
Next
Set Obj = Worksheets("Feuil1").OLEObjects("TextBox" & k)
Obj.Object.Value = Left(S, Len(S) - 1)
Exit Sub
GESTERR:
Resume Next
End SubAvec la macro que j'ai donné, pas besoin de remettre à zéro, par contre vous avez la nécessité de trier sur la colonne C (peu importe dans quel sens).
Comment pouvez vous compléter les tables si vous ne les triez pas ?
Si vous tenez absolument à pouvoir conserver l'ordre de saisie créez une colonne supplémentaire (la colonne P par exemple) colonne que vous masquerez. mais qui vous permettra de remettre la feuille dans son état initial après mise a jour.
Dans le fichier joint j'ai refait une numérotation des réservations pour créer du désordre ensuite j'ai trié sur la colonne 1 pour accentuer le bazar.
Ensuite je lance la macro plan de table.
in fine la macro remet la liste dans l'état initial (c'est à dire l'ordre des saisies (colonne P)
Attention j'ai ajouté une 'tite macro de tri (TriS) qui peut trier sur n'importe quelle colonne.
A+
Bonjour
En vous remerciant.
Cette fois je pense que le projet est terminé.
Encore Merci.
Bonne journée.
gaby.jvx