Problem d'userform
Bonjour
je ne sais pourquoi quand j'ouvre 2 fois cette useform il vas s'activer sur le Workbook mouvements alors que le but est qu'il reste ouvert mais que pour une consultation voulus de la base de donné.
car de base je veux que les utilisateur reste sur l'autre
Private Sub UserForm_Initialize()
'essaie de forcer le retour sur la bonne feuille du bon classeur sans effet
'Workbooks("Testrapportauto.xlsm").Activate
'Sheets("Report").Activate
'Range("F1048576").End(xlUp).Offset(1, 0).Select
CbInOut.RowSource = "List!ListInOut"
TxtDate = Format(Now(), " dd/mm/yy")
TxtTime = Format(Now(), "HH:MM AM/PM")
CbDriver.RowSource = "List!ListFacility"
CbCars.RowSource = "List!Listkey"
CbCard.RowSource = "List!ListCard"
CBInOutL.RowSource = "List!ListInOut"
TxtTimeL = Format(Now(), "HH:MM AM/PM")
CbDriveL.RowSource = "List!ListLamaGelbu"
CbKey1.RowSource = "List!Listkey"
CbKey2.RowSource = "List!Listkey"
CbKey3.RowSource = "List!Listkey"
CBKey4.RowSource = "List!Listkey"
CbKey5.RowSource = "List!Listkey"
CbKey6.RowSource = "List!Listkey"
End Sub
Private Sub BtnClose_Click()
Unload Me
End Sub
Private Sub BtnClear_Click()
CbInOut.Value = ""
TxtTime = Format(Now(), "HH:MM AM/PM")
CbDriver.Value = ""
CbCars.Value = ""
CbCard.Value = ""
End Sub
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
Select Case INOUT
Case "Out"
Workbooks("Mouvements.xlsx").Activate
Sheets("Keycar").Activate
Range("R4").Select
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell = CbInOut.Value
ActiveCell.Offset(0, 1) = TxtDate.Value
ActiveCell.Offset(0, 2) = TxtTime.Value
ActiveCell.Offset(0, 3) = CbDriver.Value
ActiveCell.Offset(0, 4) = CbCars.Value
ActiveCell.Offset(0, 5) = CbCard.Value
ActiveCell.Offset(0, 6) = TxtDestination.Value
'ici j'ai rescendu le code car de base je commencais par la du coup j'ai du dupliquer le code dans les 2 case
Workbooks("Testrapportauto.xlsm").Activate
Sheets("Report").Activate
Range("F1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Offset(0, 1) = Me.TxtTime.Value
ActiveCell.Offset(0, 2) = Me.CbDriver.Value & " took car key " & Me.CbCars.Value & " .(" & Me.TxtDestination.Value & ")"
Unload Me
Case "In"
Workbooks("Mouvements.xlsx").Activate
dl = Sheets("Keycar").Range("C" & Rows.Count).End(xlUp).Row + 1
Sheets("Keycar").Activate
Range("ListKey0").Find(CbCars.Value).Select
If Not ActiveCell.ListObject Is Nothing Then
Set lo = ActiveCell.ListObject
lRow = ActiveCell.Row - lo.HeaderRowRange.Row
Set lr = lo.ListRows(lRow)
lr.Range.Cut (Sheets("Keycar").Range("C" & dl))
End If
Range("ListKeyR").Find(CbCars.Value).Select
If ActiveCell.Offset(-1, -5).Value = "N°" Then
ActiveCell.Offset(0, -5).Value = "0"
Else
ActiveCell.Offset(0, -5).Value = ActiveCell.Offset(-1, -5).Value + 1
End If
ActiveCell.Offset(0, 3) = CbInOut.Value
ActiveCell.Offset(0, 4) = TxtTime.Value
ActiveCell.Offset(0, 5) = TxtDate.Value
ActiveCell.Offset(0, 6) = CbDriver.Value
ActiveCell.Offset(0, 7) = CbCars.Value
ActiveCell.Offset(0, 8) = CbCard.Value
ActiveCell.Offset(0, 9) = TxtKM.Value
Workbooks("Testrapportauto.xlsm").Activate
Sheets("Report").Activate
Range("F1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Offset(0, 1) = Me.TxtTime.Value
ActiveCell.Offset(0, 2) = "Car Key " & Me.CbCars.Value & " Back by " & Me.CbDriver.Value & " ."
Unload Me
End Select
End If
End SubHelp pls
RE bonjour
je viens d'éditer avec les fichier anonyme
Bonjour,
Voyez la feuille Comp... (nom, prenom, ID compte bancaire )
Décrivez mieux ce que vous faites car le code userform_initialize ne va pas activer le fichier mouvement
Autre chose : En voyant votre fichier, il y aurait des choses à modifier. Notamment d'éviter les RowSource (cette fonction peut être source d'erreur si mal utilisée dans les codes). Préférez lui toujours l'instruction ADDITEM ou éventuellement LIST.
Cordialement
Bonjour je sais bien c'est pour ca que j'ai joint les fichiers
Le problème n'est pas le code ou peut être si car il fait ce que je veux
il rempli dans l'autre doc et il cut copie tout marche sauf que si
J'Active le formulaire 2 fois de suite il ouvre le document ("mouvement") et il est attribue au doc comme si je l'avais lancé de la ??????????????????
pas d'autre solution pour voir le problème que de prendre les 2 doc et de tester le bouton "key"
je vous remet donc les 2 doc et effectivement j'avait oublie de supprimer des donner
ce qui se passe en étape
j'ouvre le formulaire sur le testrapport j'inscrit les donner en out ca marche jusque la zéro problème
mais quand je re ouvre le formulaire il zappe sur le classeur mouvements(ce que je veux pas ) pour autant je peux entrer les donner et le code exécute le cut /paste impeccable.
si je pouvait faire pareil mais sans que sa switch sur le mauvais doc
je viens d'un peu fouiller le net mais étant un gros novice en vba
je trouve qu'il existe des commande pour dirigé le useform
Donc je pense qu'on peut résumer mon problème en une question?
Connaitriez-vous un code qui oblige l'useforme à s'ouvrir sur le classeur testrapport.xlsm?
J'Active le formulaire 2 fois de suite il ouvre le document ("mouvement") et il est attribue au doc comme si je l'avais lancé de la ??????????????????
Je suppose que vous parlez bien du formulaire AAKeys. Si oui c'est normal parce que vous utilisez des instructions Activate. Lorsque vous relancez votre formulaire c'est toujours le fichier mouvement qui est actif.
Je vais regarder pour vous modifier le code. Par contre j'ai un bug sur Range("ListKey0").Find(CbCars.Value).Select dans la macro BtnCar_Click()
Sinon vraiment très joli fichier et usf !
cela provient du fait que j'ai du anonyme les fichier je pense
je pense qu'il vous faut mettre des valeur dans les liste car moi avec les fichier d'origine cela pose pas problème
cela provient du fait que j'ai du anonyme les fichier je pense
je pense qu'il vous faut mettre des valeur dans les liste car moi avec les fichier d'origine cela pose pas problème
Non je ne pense pas. J'utilise votre fichier avec vos données dans chacune des feuilles. je dois analyser... pas simple car les codes sont programmés sans tenir compte des codes que l'on utilise lorsque les tableaux sont au format structurés. Vous êtes en tableau structuré et si vous n'avez pas de première ligne cela buggue.
je dois analyser
Dans votre code BtnCar_Click à la partie Select Case INOUT, supprimez les deux Unload me (dans case In et Case Out)
Sinon vous auriez intérêt à enlever les Activate, Select et activcell dans les codes. c'est cela qui vous donne les soucis
Vu que vos tableaux sont au format structuré, le code devrait être programmé autrement. Cela vous éviterait des soucis comme celui dont je vous ai parlé avant.
Si vous voulez je peux regarder de ce coté.
Exemple pour votre USF ADDKeys, le code d'ouverture devrait plutot être ceci
Private Sub UserForm_Initialize()
With ThisWorkbook.Sheets("List")
CbInOut.List = .ListObjects("ListInout").DataBodyRange.Value
TxtDate = Format(Now(), " dd/mm/yy")
TxtTime = Format(Now(), "HH:MM AM/PM")
CbDriver.List = .ListObjects("TFacility").DataBodyRange.Value
CbCars.List = .ListObjects("Tkeys").DataBodyRange.Value
CbCard.List = .ListObjects("TCards").DataBodyRange.Value
CBInOutL.List = .ListObjects("listInOut").DataBodyRange.Value
TxtTimeL = Format(Now(), "HH:MM AM/PM")
CbDriveL.List = .ListObjects("TLG").DataBodyRange.Value
CbKey1.List = .ListObjects("TKeys").DataBodyRange.Value
CbKey2.List = .ListObjects("TKeys").DataBodyRange.Value
CbKey3.List = .ListObjects("TKeys").DataBodyRange.Value
CBKey4.List = .ListObjects("TKeys").DataBodyRange.Value
CbKey5.List = .ListObjects("TKeys").DataBodyRange.Value
CbKey6.List = .ListObjects("TKeys").DataBodyRange.Value
End With
End subDites moi déjà sur le souci de votre demande
je vous remercie et oui si vous avez le courage de voir à optimiser tout le doc ce serait génial car je suis débutant j'ai pris des bouts de code en suivant divers tuto YouTube et les ai copié en comprenant et en modifiant pour arriver à mes fins.
après je me doute qu'il y as grandement moyen d'optimiser cela
déjà un grand merci pour votre temps a check mon problème je test votre code et vous donne un retour
Edit Nickel ca marche de ouf merci
j'ai essaye de copier votre code dans l'autre useform
et ca me mettre un erreur 9
Private Sub UserForm_Initialize()
With ThisWorkbook.Sheets("List")
TbDate.Text = Format(Now(), "dd/mm/yy")
TbTime.Text = Format(Now(), "HH:MM AM/PM")
CbFrom.List = .ListObjects("ListFileName").DataBodyRange.Value
TxtDAteO.Text = Format(Now(), "dd/mm/yy")
TxtTimeO.Text = Format(Now(), "HH:MM AM/PM")
End With
End Sub???
P.S je suis perdu
j'ai essaye de copier votre code dans l'autre useform et ca me mettre un erreur 9
Oui logique. Vous devez utiliser la définition de base des tableaux struturés. Donc celle dont les noms commencent par T. Du coup les autres ne vont plus servir en principe.
Dans votre code remplacez
CbFrom.List = .ListObjects("ListFileName").DataBodyRange.Valuepar ceci (en principe ListfileName ne devrait plus servir) :
CbFrom.List = .ListObjects("TFileName").DataBodyRange.Valueje vous remercie et oui si vous avez le courage de voir à optimiser tout le doc ce serait génial
Cela va prendre un certain temps car je dois analyser tout ce qui se passe actuellement. Je vais regarder l'USF Gfile
Un tout grand merci
Dans l'usf Gfile
1. Code initialize
Private Sub UserForm_Initialize()
With ThisWorkbook.Sheets("List")
TbDate.Text = Format(Now(), "dd/mm/yy")
TbTime.Text = Format(Now(), "HH:MM AM/PM")
CbFrom.List = .ListObjects("TFileName").DataBodyRange.Value
TxtDAteO.Text = Format(Now(), "dd/mm/yy")
TxtTimeO.Text = Format(Now(), "HH:MM AM/PM")
End With
End Sub2. Code Private Sub BtAddFile_Click()
Private Sub BtAddFile_Click()
Dim lig As Integer
If Len(Me.TbNumber) = 0 Then
Me.LblError = "Enter File N°"
Me.TbNumber.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)
.DataBodyRange.Item(lig, 2) = Me.TbTime.Value
.DataBodyRange.Item(lig, 3) = Me.CbFrom.Value & " gives the file N° " & Me.TbNumber.Value & " ."
End With
With Workbooks("Mouvements.xlsx").Sheets("File").ListObjects("TFileI")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
With .DataBodyRange
.Item(lig, 1) = TbNumber.Value
.Item(lig, 2) = TbDate.Value
.Item(lig, 3) = TbTime.Value
.Item(lig, 4) = CbFrom.Value
End With
End With
End If
End subVoir si vous voulez fermer l'usf après l'ajout ou pas. Je suppose que vous utiliserez le bouton Close
Rem : Dans la feuille FILE, je ne comprends pas pourquoi vous avez inclus des titres dans la ligne 4 et que vous avec masquées
bonjour
Et désoler
ca marche nickel pour le in file
par contre je vois pas comment change le out
svp un petit coup de pouce .?
P.S pour le in tu peux faire que le numéro sur le rapport s'incrémente ?
Bonjour
1. Toujours pour G_file, voici le code pour le Bouton btnOutFile_Click
Private Sub btnOutFile_Click()
Dim Valid As Byte
Dim lig As Integer, lo As Integer
Valid = MsgBox("File " & TxtNumR & " you sure ?", vbYesNo + vbDefaultButton2, "Verification")
If (Valid = 7) Then
CbGuardR = ""
Exit Sub
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.TxtTimeO.Value
.DataBodyRange.Item(lig, 3) = Me.TxtNameO.Value & " took the file N° " & Me.TxtNumR.Value & " ."
End With
With Workbooks("Mouvements.xlsx").Sheets("File")
lo = .ListObjects("TFileI").ListColumns(1).DataBodyRange.Find(TxtNumR.Value, lookat:=xlWhole).Row
If lo > 0 Then
With .ListObjects("TFile0")
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
End With
With .ListObjects("TFileI")
.ListRows(lo - .HeaderRowRange.Row).Range.Copy .ListObjects("TFile0").ListRows(lig).Range
.ListRows(lo - .HeaderRowRange.Row).Range.Delete
End With
End If
End With
End If
End SubPouvez-vous tester ?
2. pour le in tu peux faire que le numéro sur le rapport s'incrémente
Dans le code Private Sub BtAddFile_Click(), il suffit d'ajouter + 1 dans cette ligne -->
.DataBodyRange.Item(lig, 1) = WorksheetFunction.Max(.ListColumns(1).DataBodyRange.Value) + 13. par contre je vois pas comment change le out. svp un petit coup de pouce .?
Cela va prendre un certain temps mais je peux regarder oui
4. Vous ne répondez pas à la question posée en Remarque dans mon post précédent. Quid ?
Re Bonjour Dan
Déjà un immense merci .
juste un petit soucis
With .ListObjects("TFileI")
.ListRows(lo - .HeaderRowRange.Row).Range.Copy .ListObjects("TFile0").ListRows(lig).Range
il met une erreur ici
je suis trop novice pour voir le problème
Sinon car marche nickel jusqu'au copier
Exact, j'ai omis de mettre la référence du fichier. Changez cette ligne
.ListRows(lo - .HeaderRowRange.Row).Range.Copy Workbooks("Mouvements.xlsx").Sheets("File").ListObjects("TFile0").ListRows(lig).Rangedans l'attente de votre retour pour la suite
Bonjour Dan
Merci de l'aide ca marche nickel
Mais en retestant tout mon doc du coup sur le fenêtre WOrker ca fait pareil
Pourriez vous crée le code pour cette user form en in et out ?
Si vous avez le temps
aussi mais ca na plus rien avoir avoir le sujet
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
désolé c'est trop compliquer pour moi avec votre méthode
P.S = je vais tester de copier coller et d'adapter votre code pour le 2 onglet dans key je vous tiens au courant
Mais je voulais encore vous remercier de votre aide c'est génial d'avoir quelqu'un qui donne de son temps