Problem d'userform
Bonjour,
A. Mais en retestant tout mon doc du coup sur le fenêtre WOrker ca fait pareil
Je n'ai pas encore revu cette USF. cela reste à faire. J'ai procédé par ordre des USF dans VBA
B. Est-il possible que à chaque in out des files s'affiche ou efface les files qui sont sorti(le but est d'avoir un liste juste avec les files qui sont in et une fois out soit sorti de la list) sur un List ou table partant de B18 àB35
je n'ai pas compris ce que vous voulez faire par rapport à votre fichier et sur quelle feuille entre B18 et B35 ?. On peut regarder cela après les modifications je suppose
C. Pourriez vous crée le code pour cette user form en in et out ?
Voici ce qui est à modifier dans cette USF
1. Modification dans la feuille List
- supprimez d'abord la ligne 5 (celle où vous avez 0, Select Guard, ....).
- Supprimez ensuite les lignes 20 à 26. Votre dernière ligne dans ce tableau devient la ligne 14
- Supprimez la colonne U (NomList)
2. USF ADDInOut - codes à modifier
2-1. Code initialize
Private Sub UserForm_Initialize()
With ThisWorkbook.Sheets("List")
TBTime.Text = Format(Now(), "HH:MM AM/PM")
CbFonction.List = .ListObjects("Tfonction").ListColumns(1).DataBodyRange.Value: CbFonction.Value = "Select"
CbCar.List = .ListObjects("TCars").DataBodyRange.Value
CbEntrance.List = .ListObjects("TEntrance").DataBodyRange.Value
CbSite.List = .ListObjects("TSite").DataBodyRange.Value
CbName = "Select Fonction"
ObNoir = True
End With
End sub2-2. Code affichage_name
Private Sub affichage_Name()
Dim Mc As Range
With ThisWorkbook.Sheets("List")
Set Mc = .ListObjects("Tfonction").DataBodyRange.Find(CbFonction.Value)
If Not Mc Is Nothing Then CbName.List = .ListObjects("T" & CbFonction).DataBodyRange.Value: CbName.ListIndex = 0
End With
End Sub2-3. code du Bouton Clear
Remplacez cette ligne
CbSite.RowSource = "List!ListSite": CbSite.ListIndex = 0par
CbSite.List = ThisWorkbook.Sheets("List").ListObjects("TSite").DataBodyRange.Value2-4. code du Bouton Enregistrer
Private Sub Button_register_Click()
Dim lig As Integer
If Len(Me.CbFonction) = "Select" Then
Me.LblError = "Enter a Fonction"
Me.CbFonction.SetFocus
Else
With Report.ListObjects("TReport")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
.DataBodyRange.Item(lig, 1) = WorksheetFunction.Max(.ListColumns(1).DataBodyRange.Value) + 1
.DataBodyRange.Item(lig, 2) = Me.TBTime.Value
.DataBodyRange.Item(lig, 3) = Me.CBEvent.Value & " " & Me.CbName.Value & " by " & Me.CbEntrance.Value & "(" & CbCar.Value & ")"
End With
End If
End SubFaites un test
Merci Dan je m'y atele de suite
1.Bonjour ca marche nickel le cb even qui existait plus j'ai juste vire pour un "IN"
.DataBodyRange.Item(lig, 3) = "IN " & Me.CbName.Value & " by " & Me.CbEntrance.Value & "(" & CbCar.Value & ")." & Me.TXTDescriptiondu coup zero problem
2. sur un autre post un membres du forum m'avais donner un code pour la couleur je l'ai incoporer à votre code
cela donne ceci c'est pour appliquer la couleur du coup je sais pas ou et comment ( je fait des test j'editerais peut -etre en dessous)
Private C As Variant
Private Sub UserForm_Initialize()
With ThisWorkbook.Sheets("List")
TBTime.Text = Format(Now(), "HH:MM AM/PM")
CbFonction.List = .ListObjects("Tfonction").ListColumns(1).DataBodyRange.Value: CbFonction.Value = "Select"
CbCar.List = .ListObjects("TCars").DataBodyRange.Value
CbEntrance.List = .ListObjects("TEntrance").DataBodyRange.Value
CbSite.List = .ListObjects("TSite").DataBodyRange.Value
CbName = "Select Fonction"
ObNoir = True
End With
End Sub
Private Sub CbFonction_Change()
affichage_Name
End Sub
Private Sub affichage_Name()
Dim Mc As Range
With ThisWorkbook.Sheets("List")
Set Mc = .ListObjects("Tfonction").DataBodyRange.Find(CbFonction.Value)
If Not Mc Is Nothing Then CbName.List = .ListObjects("T" & CbFonction).DataBodyRange.Value: CbName.ListIndex = 0
End With
End Sub
Private Sub TxtDescription_Change()
If ObNoir.Value = True Then
TxtDescription.ForeColor = &H80000012
ElseIf OB_Bleu.Value = True Then
TxtDescription.ForeColor = &HFF0000
ElseIf OB_Rouge.Value = True Then
TxtDescription.ForeColor = &HFF&
ElseIf OB_Vert = True Then
TxtDescription.ForeColor = &HC000&
End If
End Sub
Private Sub ObNoir_Click()
C = &H80000012: Call ChangeCoul
End Sub
Private Sub OB_Bleu_Click()
C = &HFF0000: Call ChangeCoul
End Sub
Private Sub OB_Rouge_Click()
C = &HFF&: Call ChangeCoul
End Sub
Private Sub OB_Vert_Click()
C = &HC000&: Call ChangeCoul
End Sub
Private Sub Button_close_Click()
Unload Me
End Sub
Private Sub Button_clear_Click()
TBTime.Text = Format(Now(), "hh:mm AM/PM")
CbFonction.Value = "Select"
CbCar.Value = ""
CbEntrance.Value = ""
CbSite.List = ThisWorkbook.Sheets("List").ListObjects("TSite").DataBodyRange.Value
CbName.Value = "Select Fonction"
ObNoir.Value = True
End Sub
Private Sub Button_register_Click()
Dim lig As Integer
If Len(Me.CbFonction) = "Select" Then
Me.LblError = "Enter a Fonction"
Me.CbFonction.SetFocus
Else
With Report.ListObjects("TReport")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
'.DataBodyRange.Font.Color = C << test mais je peux pas choisir l'item
.DataBodyRange.Item(lig, 1) = WorksheetFunction.Max(.ListColumns(1).DataBodyRange.Value) + 1
.DataBodyRange.Item(lig, 2) = Me.TBTime.Value
.DataBodyRange.Item(lig, 3) = "IN " & Me.CbName.Value & " by " & Me.CbEntrance.Value & "(" & CbCar.Value & ")"
End With
End If
End Sub- Supprimez ensuite les lignes 20 à 26. Votre dernière ligne dans ce tableau devient la ligne 14
Etes-vous sur car sur mon doc officiel nous sommes 21 agent et peut etre plus
dsl je peux pas editer le message d'avant pour la question
B. Est-il possible que à chaque in out des files s'affiche ou efface les files qui sont sorti(le but est d'avoir un liste juste avec les files qui sont in et une fois out soit sorti de la list) sur un List ou table partant de B18 àB35
je n'ai pas compris ce que vous voulez faire par rapport à votre fichier et sur quelle feuille entre B18 et B35 ?. On peut regarder cela après les modifications je suppose
il s'agit du range sur la feuille rapport si faisable de la je pourrais copier pour les badge out key out et card out
Pour le userform addkey
J'ai travailler à retirer le code pour le transformer comme le tiens ca marche en grande partie
Pour le in key zero soucis ca se fait nickel
Pour le out la j'arrive à faire le copier coller le hic c'est qu'il faudrais le decaler pour qu'il colle à partir de la 2 eme colonne et sur la premiere il increment un numero
et l'ajout des nouvelles donnée se fait pas
je te joint le code qui par de ton trvail mais que j'arrive pas à ajuster tout comme il faut
Private Sub BtnCar_Click()
Dim INOUT As String
INOUT = CBInOut.Value
If Len(Me.CBInOut) = 0 Then
Me.LblError = "Select IN or OUT"
Me.CBInOut.SetFocus
ElseIf Len(Me.CbDriver) = 0 Then
Me.LblError = "Select a Name"
Me.CbDriver.SetFocus
ElseIf Len(Me.CbCars) = 0 Then
Me.LblError = "Select a Key"
Me.CbCars.SetFocus
ElseIf Len(Me.TxtDestination) = 0 And Me.CBInOut = "Out" Then
Me.LblError = "Enter a Destination"
Me.TxtDestination.SetFocus
ElseIf Len(Me.TxtKM) = 0 And Me.CBInOut = "In" Then
Me.LblError = "Enter KM"
Me.TxtKM.SetFocus
Else
If Me.CBInOut = "Out" Then
With Report.ListObjects("TReport")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
.DataBodyRange.Item(lig, 1) = WorksheetFunction.Max(.ListColumns(1).DataBodyRange.Value) + 1
.DataBodyRange.Item(lig, 2) = Me.TxtTime.Value
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " took car key " & Me.CbCars.Value & " .(" & Me.TxtDestination.Value & ")"
End With
With Workbooks("Mouvements.xlsx").Sheets("Keycar").ListObjects("TKeyO")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
With .DataBodyRange
.Item(lig, 1) = CBInOut.Value
.Item(lig, 2) = TxtDate.Value
.Item(lig, 3) = TxtTime.Value
.Item(lig, 4) = CbDriver.Value
.Item(lig, 5) = CbCars.Value
.Item(lig, 6) = CbCard.Value
.Item(lig, 7) = TxtDestination.Value
End With
End With
Else
With Report.ListObjects("TReport")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
.DataBodyRange.Item(lig, 1) = WorksheetFunction.Max(.ListColumns(1).DataBodyRange.Value) + 1
.DataBodyRange.Item(lig, 2) = Me.TxtTime.Value
If Me.CbCard = 0 Then
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & " .(" & Me.TxtDestination.Value & ")"
Else
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & "and the badge " & Me.CbCard.Value & " .(" & Me.TxtDestination.Value & ")"
End If
End With
With Workbooks("Mouvements.xlsx").Sheets("Keycar")
lo = .ListObjects("TKeyO").ListColumns(5).DataBodyRange.Find(CbCars.Value, lookat:=xlWhole).Row
If lo > 0 Then
With .ListObjects("TKeyCar")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
End With
With .ListObjects("TKeyO")
.ListRows(lo - .HeaderRowRange.Row).Range.Copy Workbooks("Mouvements.xlsx").Sheets("Keycar").ListObjects("TKeyCar").ListRows(lig).Range
.ListRows(lo - .HeaderRowRange.Row).Range.Delete
With .DataBodyRange
.Item(lig, 9) = CBInOut.Value
.Item(lig, 10) = TxtDate.Value
.Item(lig, 11) = TxtTime.Value
.Item(lig, 12) = CbDriver.Value
.Item(lig, 13) = CbCars.Value
.Item(lig, 14) = CbCard.Value
.Item(lig, 15) = TxtKM.Value
End With
End With
End If
End With
End If
End If
End SubP.S je vais finir le dernier userform et je peux te redonner des blanco si besoin avec les dernier ajout
Bonjour
1. Je vais d'abord répondre à votre message --> https://forum.excel-pratique.com/s/goto/1045684
A. Ok j'ai corrigé de mon coté
B. Ce que vous voulez faire c'est mettre la couleur choisie dans la cellule H de la feuille Report ? Si oui, c'est la cellule ou le texte qui doit être en couleur
C. Etes-vous sur car sur mon doc officiel nous sommes 21 agent et peut etre plus
Oui c'est le but des tableaux structurés. Supprimez les lignes que je vous ai dites, puis à titre d'essai, mettez vous sur B20 (qui, après suppression des lignes, ne fait plus partie du tableau) et ajouter le numéro 15. Le tableau va s'adapter automatiquement
2. réponse à votre message --> https://forum.excel-pratique.com/s/goto/1045711
A. je peux pas editer le message d'avant pour la question
Si. Il vous suffit de vous positionner sur le post puis vous cliquez sur le petit crayon en haut à droite de ce post.
B. il s'agit du range sur la feuille rapport si faisable de la je pourrais copier pour les badge out key out et card out
Ok je vois. Peut être voir cela après avoir réglé les USF.
3. https://forum.excel-pratique.com/s/goto/1045743
A. je te joint le code qui par de ton trvail mais que j'arrive pas à ajuster tout comme il faut
J'y avais travaillé hier. J'arrive à peu près à la même chose. Que doit-on trouver en colonne R (IN). Un chiffre ?
B. Il me faudrait plus d'explications sur :
- le fonctionnement du IN et le OUT. Exemple : si je n'ai pas de ligne OUT pour la valeur KEY en colonne V et que je choisis IN dans l'USF ?
- le choix de la page dans l'USF
bonjour Dan
Merci pour votre aide .Vous êtes si génial
1.Alors Pour la couleur oui juste le H
B. Ce que vous voulez faire c'est mettre la couleur choisie dans la cellule H de la feuille Report ? Si oui, c'est la cellule ou le texte qui doit être en couleur
les reste du code couleur marche pour les Txt Description marche pour un visuel dans useform .
2. Pour le
Oui c'est le but des tableaux structurés. Supprimez les lignes que je vous ai dites, puis à titre d'essai, mettez vous sur B20 (qui, après suppression des lignes, ne fait plus partie du tableau) et ajouter le numéro 15. Le tableau va s'adapter automatiquementc'est fait et maj du personnel et cette userform ne décorne pas donc pour moi ainsi que le add worker peut rester ainsi sauf si vous voulez maj le code a vous de voir.
3.Tout à fait d'accord
B. il s'agit du range sur la feuille rapport si faisable de la je pourrais copier pour les badge out key out et card out
Ok je vois. Peut être voir cela après avoir réglé les USF.
4. Tout simple IN je sais mais mon chef y tiens .c'est pour la présentation au client.
J'y avais travaillé hier. J'arrive à peu près à la même chose. Que doit-on trouver en colonne R (IN). Un chiffre ?votre code sera surement mieux que le mien.
5 . Pour un question désoler je sais pas comment vous fait les liens
Mais vous aviez poser la question pour les ligne 4 cacher .Vous Aviez raison après plusieurs test le faite de cacher et de recopier la ligne est pas viable.
j'ai donc modifier comme vous l'aviez proposer j'ai afficher la ligne 4 vider la 1 ligne et viré les bouton filtre (pour les collègues novice en pc).
Cela change-t-il le code ou le simplifie pour vous?
6. Problème avec copier coller file et Key
après un vérification hier soir de la globalité et présentation de l'avancement à mon chef il apparait le que copier et delete se fait bien c'est après l'ajout des donné du userform ne s'applique pas sur le coté. pourriez-vous regarder ? car pour autant excel ne detecte pas d'erreur dans le code.
Dsl c'est long peut-être devrions-nous concentré sur un problème à la fois
P.S je finis tantôt le dernier userform en tout cas le visuel. Et je vous joindrez les nouveau doc en mode anonyme
1.Alors Pour la couleur oui juste le H
Vous ne répondez pas à la question complètement.
2. c'est fait et maj du personnel et cette userform ne décorne pas donc pour moi ainsi que le add worker peut rester ainsi sauf si vous voulez maj le code a vous de voir.
Prenez le fichier joint et remplacez tous les codes dans l'USF ADDagent par ceux repris dans le fichier
3.Tout à fait d'accord
A revoir donc
4. Tout simple IN je sais mais mon chef y tiens .c'est pour la présentation au client.
Donc on met simplement le texte IN ?
5. j'ai donc modifier comme vous l'aviez proposer j'ai afficher la ligne 4 vider la 1 ligne et viré les bouton filtre (pour les collègues novice en pc).
Coté code rien ne change vu que la ligne était dans le tableau structuré. Vous pouvez supprimer la ligne 5 et pour la ligne 4 les filtres peuvent être désactivés en cliquant sur une cellule dans cette ligne, puis en allant dans le menu "Création Tableau". Là il suffit de décocher la case "Bouton de filtre". Mais le filtre peut rester intéressant si on a beaucoup de données. A vous de voir si utile ou pas
6. Problème avec copier coller file et Key
On le verra plus tard. Voyez déjà pour les points 1 et 2
bonjour Dan
1.Alors Pour la couleur oui juste le H
Vous ne répondez pas à la question complètement.Le texte uniquement
LE userform add agent marche nickel avec votre code
Je me suis permis d'ajouter un msgbox pour bien afficher le nouvelle agent est bien ajouter
et fait un call comme sur delete pour fermer userform
Merci
Voici pour la couleur du texte en colonne H.
- Dans l'usf ADDINOUT, supprimez les 4 codes Private Sub ObNoir_Click, Private Sub Bleu_Click, Private Sub OB_Rouge_Click, Private Sub OB_Vert_Click
- supprimez aussi le code Changcoul
- dans le code Private Sub Button_register_Click, juste avant le END WITH, ajoutez cette ligne
.DataBodyRange.Item(lig, 3).Interior.Color = Me.TxtDescription.ForeColorJe me suis permis d'ajouter un msgbox pour bien afficher le nouvelle agent est bien ajouter et fait un call comme sur delete pour fermer userform
Ok. Si vous me dites où je peux les rajouter mais cela n'a pas beaucoup d'importance si tout fonctionne chez vous pour cette userform.
Je vais continuer sur l'usf Keys dès que j'ai réponse aux questions point 4 de mon post précédent et le fonctionnement (https://forum.excel-pratique.com/s/goto/1045788, point 3B du matin)
Bonjour Dan
J'y avais travaillé hier. J'arrive à peu près à la même chose. Que doit-on trouver en colonne R (IN). Un chiffre ?
B. Il me faudrait plus d'explications sur :
- le fonctionnement du IN et le OUT. Exemple : si je n'ai pas de ligne OUT pour la valeur KEY en colonne V et que je choisis IN dans l'USF ?
- le choix de la page dans l'USFdans se cas la je pense mettre un msgbox "The Key is not Out " . si in et num de key pas trouver dans le tableau out et un setfocus sur le combox du choix de clef
Donc en cas de out("TKeyO") =sortie de la clefs de nos service
le cas IN("TkeyCar") = le chauffeur rend la clef
Apres j'avoue j'ai confondu aussi a la creation des table donc En colonne C et R = in deviens Out et en colonne J Out deviens in
Comme dit j'ai fait apparaitre ligne 4 et cleaner la ligne 5 de base et juste changer les titres
4. Tout simple IN je sais mais mon chef y tiens .c'est pour la présentation au client.
Donc on met simplement le texte IN ?
donc si on parle bien de l'userform addkey in ? oui
donc dans le rapport colonne H je pensais mettre avec une condition si
If Me.CbCard = 0 Then
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & " ."
Else
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & "and the badge " & Me.CbCard.Value & " ."
End Ifet pour le Out
If Me.CbCard = 0 Then
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & " .(" & Me.TxtDestination.Value & ")"
Else
.DataBodyRange.Item(lig, 3) = Me.CbDriver.Value & " give car key " & Me.CbCars.Value & "and the badge " & Me.CbCard.Value & " .(" & Me.TxtDestination.Value & ")"
End Ifapres je suis pas convaincu du code mais l'idée est la si badge tel phrase si pas de badge referencer tel phrase
j'espere avoire repondu a tout les questions de facon precise
sinon dit moi quoi
.DataBodyRange.Item(lig, 3).Interior.Color = Me.TxtDescription.ForeColor
je me suis permis et ca marche nickel de changer Interior par Font
je crois avoir compris comment marche le code avec with je vais travailler sur l'enregistrement sur la bonne feuille dans mouvements tu auras peut etre des idées d'amelioration je te le donnerai apres car compliquer
je reviens vers toi
Et encore une fois mille merci t'est au top
Bonjour
je me suis permis et ca marche nickel de changer Interior par Font
Oui effectivement. c'est moi qui ai omis de changer lorsque j'ai posté après votre confirmation sur le Texte
Avant de repasser sur l'USF Key, j'ai modifié l'USF Worker. Voici ce qu'il faut faire :
1. Dans la feuille Comp, supprimez les infos de la colonne D entre les lignes 2 et 7. Du coup, la définition du tableau "Tlistcomp" ne concerne plus que les infos entre les cellules C2 et C7
2. Dans l'USF Addworker, remplacez les codes par ceux repris dans le fichier joint
Remarques au sujet de la feuille Comp
- Votre tableau Company, pourrait être placé en colonne B9 plutôt que de le mettre à la ligne 2. Du coup tous les tableaux seraient alignés.
- Je n'ai pas compris l'utilité du tableau de droite ListworkerID. Partant de ce tableau vous auriez aussi pu faire un seul tableau sous forme de base de données en ajoutant une colonne pour la compagnie, deux colonnes pour Nom et Prenom et une colonne précisant si le travailleur est Others ou pas. A voir si intérêt ou pas.
Merci pour se code comme d'habitude ca marche
1. y avais une tout petite erreur que j'ai trouver en testant mais rien de grave
MsgBox "The guard " & CbWorkerR.Value & "has been deleted"a changer si tu veux le tester
2.changement logique
- Votre tableau Company, pourrait être placé en colonne B9 plutôt que de le mettre à la ligne 2. Du coup tous les tableaux seraient alignés
c'est fait ainsi que tout les delete
3. explication
Je n'ai pas compris l'utilité du tableau de droite ListworkerID
Cela sert dans le userform inoutworker pour que quand le worker est selectionner l'id du travailleur s'affiche en auto (peut-etre plus utiles avec votre méthode) si pas faudrait ajouter l'écriture dans ce tableau (a voir que on travaillera sur le userfor inoutworker)
pourquoi l'id allez vous me demander c'est une demande du client sur les feuilles du classeur mouvements.
1. y avais une tout petite erreur que j'ai trouver en testant mais rien de grave
Ok. Corrigé de mon coté. désolé
2. changement logique Votre tableau Company, pourrait être placé en colonne B9
J'ai également fait cela. Vu ce changement vous pouvez cette macro dans Addworker
Private Sub UserForm_Initialize()
With Comp.ListObjects("TListcomp").DataBodyRange
CBCompany.List = .Value
CbCompR.List = .Value
End With
LblError = " Veuillez remplir tout les champs "
End SubMaintenant vous pourriez supprimer les lignes1 à 8. De cette sorte tous les tableaux commenceront en ligne 1
3. explication : Cela sert dans le userform inoutworker pour que quand le worker est selectionner l'id du travailleur s'affiche en auto (peut-etre plus utiles avec votre méthode) si pas faudrait ajouter l'écriture dans ce tableau (a voir que on travaillera sur le userfor inoutworker)
Je n'ai pas encore regarder cette userform mais de base il n'y avait pas de souci pour arranger le code.
4. Dans l'USF Addpatrol, remplacez les codes par ceux repris dans le fichier joint
Faites un test car je ne suis pas sûr des valeurs Rowsource que vous aviez mise dans pour les combobox
Bonjour Dan
Comme d'hab. ca marche nickel juste un tout petit erreur dans un nom de table
TRound à la place de Tround
Mais vue le boulot que tu abat même moi je me trompe a force trop de ligne
Pour les optimisation de de la feuille comp c'est fait et le code addworker aussi
P.S je te pm un code pour le inout