Discussion :

[MicKRub]

Bonjour,

Afin de perfection mon fichier et de rendre la vie plus facile à mes chefs, je désire que lorsqu'un employé saisie des heures supplémentaires, cela les note directement à la bonne place ( c'est à dire à la ligne correspondant à son nom et à la date correspondante.)

J'ai crée un UserForm permettant la saisie des heures supplémentaire. (voir image)



Lorsque j'insère la date cela sélection la bonne case selon la date. (Cela fonctionne avec le code ci-dessous)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Private Sub MaDate_AfterUpdate()
Dim DateRecherchee As Date
Dim AnneeEnCours As String
Dim chainevide As String
Dim Nomfichier As String
 
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
AnneeEnCours = Format(Worksheets("2018").Range("AA1").Value, "yyyy")
chainevide = "--.--." & AnneeEnCours
 
UnprotectSheet
Application.ScreenUpdating = False
 
On Error GoTo Invalide
 
UnprotectSheet
DateRecherchee = Me.MaDate.Value
Application.GoTo Reference:=Worksheets("2018").Range("AB11:ACD11").Find(DateRecherchee).Offset(14, 0), Scroll:=False
ProtectSheet
 
Exit Sub
 
Invalide:
        MsgBox ("Cette date n'est pas valide pour le fichier " & Nomfichier & " ."), vbCritical
        Me.MaDate.Value = chainevide
 
End Sub

Je désire maintenant que lorsque l'employé sélectionne son nom dans la ComboBox, cela sélectionne une ligne sous son nom. Ici ça ne fonctionne pas et me met une erreur d’exécution 91 :-(

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub ChoixAmbu_Change()
Dim NomRecherche As String
Dim Nomfichier As String
 
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
 
Application.ScreenUpdating = False
 
On Error GoTo Invalide
UnprotectSheet
 
Application.GoTo Reference:=Worksheets("2018").Range("A25:A183").Find(NomRecherche).Offset(1, 2), Scroll:=False ' <----- ligne soulignée en jaune après erreur d’exécution 91
 
Exit Sub
Invalide:
        MsgBox ("Cet utilisateur n'est pas valide pour le fichier " & Nomfichier & " ."), vbCritical
End Sub

En finalité, j'aimerai que lorsque la date, le nom et que le reste des informations de l'UserForm sont entrées, cela copie le résultat du calcul d'heures supplémentaire à la bonne place.

Déjà un grand merci pour votre aide.

Cordialement

[patricktoulon]

re
avec find dans la colonne "M" cela devrait faire l' affaire non? pour sélectionner la ligne

bien que la capture soit pas très net je vois quelque chose d'écrit en subscript dans chaque cellule ambulancier forcement le find ne fonctionnera pas avec find(comboboxX.value) puisque la combobox contient que l'ambulancier pas ce qui'il y a écrit en subscript peut etre avec " xlpart" en argument du find mais c'est pas propre et sur

pour les date
tu fait un find sur le format text du mois sur la ligne des mois en lettre qui est une fusion tu prend le mergearea.offset(1,0) et tu a ta plage ou se trouve les jour de ce mois la
tu n'a plus qu' faire le find sur le jour

ce sont des choses aux quelles on pense avant dans la conception surtout quand on pilote le sheets a partir d'un userform

[MarcelG]

Bonjour à toi, Bonjour au Forum

En simplifiant et en utilisant la méthode Find suivant l'aide en ligne.

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub ChoixAmbu_Change()
 
Application.ScreenUpdating = False
 
Dim trouve As Range
Set trouve = Worksheets("2018").Range("A25:A183").Find(ChoixAmbu.Value)
 
If trouve Is Nothing Then
    MsgBox ("Cet utilisateur n'est pas valide pour le fichier " & ThisWorkbook.Name & " ."), vbCritical
Else
    Application.GoTo Reference:=trouve.Offset(1, 2), Scroll:=False
End If
 
Set trouve = Nothing
 
End Sub

Remarque, tu n'as aucune obligation de sélectionner des cellules pour leur affecter des valeurs.

[MarcelG]

Pardon, Patrick, pour ce télescopage.
Ton post est bien entendu à considérer avant tout.

[patricktoulon]

re
regarde cet exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CommandButton1_Click()
mois = Format(TextBox1.Value, "mmmm")
Set rangemois = Rows("1:1").Find(mois, lookat:=xlValue)
jour = Val(Format(TextBox1, "dd"))
rowdubonhomme = Range("A4:A10").Find(ComboBox1.Value, lookat:=xlValue).Row
Set plagejour = ActiveSheet.Range(Replace(rangemois.MergeArea.Address, rangemois.MergeArea.Row, 2))
colonnedujour = plagejour.Find(jour, lookat:=xlValue).Column
Cells(rowdubonhomme, colonnedujour).Select
End Sub
Private Sub UserForm_Activate()
ComboBox1.List = Range("A4:A10").Value
End Sub

fichier en exemple

[MicKRub]

Merci pour votre aide,

J'avais fait une erreur...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Application.GoTo Reference:=Worksheets("2018").Range("A25:A183").Find(NomRecherche).Offset(1, 2), Scroll:=False ' <----- ligne soulignée en jaune après erreur d’exécution 91

Alors que c'est "AA25:AA183" et non "A25:A183"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Application.GoTo Reference:=Worksheets("2018").Range("AA25:AA183").Find(NomRecherche).Offset(1, 2), Scroll:=False

Maintenant il faut que j'arrive a me placer sur la cellule correspondant au la date et à l'employé, pour finalement y noter le résultat du calcul lorsque je ferme mon UserForm en cliquant sur le bouton envoyé (cela envoie également un mail au chef pour annoncer les heures supplémentaires.)

Donc je pense que tout va se dérouler en cliquant sur le bouton Envoyer. Mais comment?

Merci à vous

[MicKRub]

Merci @patricktoulon, je vais tester cela.

[patricktoulon]

re
oui bien evidement la bonne blague adapter le depart a ton cas n'ayant pas ton fichier je me suis fait un exemple vite fait resemblant au tiens

[MicKRub]

J'ai vu votre fichier vite fait.

J'essaie depuis 8h ce matin en vain et vous en quelques minutes c'est fait.

c'est beau

[MicKRub]

J'ai essayé d'adapter votre code mais ça ne marche pas. cela me met Erreur définie par l'application ou définie par l'objet ici,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(NomAmbulancier, Colonnedujour).Select

Ensuite j'aimerai arriver une cellule en dessous de celle sélectionner via

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(NomAmbulancier, Colonnedujour).Select

Et y copier mon résultat de calcul

J'ai fait un test avec un MsgBox et cela me retourne bien des valeurs.
Exemple si je met 01.01.2018 et ambulancier 1, mon message box me retourne Nom en ligne 49 / Date en colonne 29

Merci beaucoup de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
 
Private Sub Bouton_Valider_Click()
Dim DateRecherchee As Date
Dim NomRecherche As String
Dim Nomfichier As String
 
Dim NomAmbulancier As String
Dim Colonnedujour As String
 
Dim CopieCalcul As String
 
DateRecherchee = Me.MaDate.Value
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
 
CopieCalcul = Me.ResultatHS.Caption
 
Application.ScreenUpdating = False
 
UnprotectSheet
 
NomAmbulancier = Worksheets("2018").Range("AA25:AA183").Find(NomRecherche, lookat:=xlValue).Row
Colonnedujour = Worksheets("2018").Range("AB11:ACD11").Find(DateRecherchee, lookat:=xlValue).Column
 
MsgBox ("Nom en ligne " & NomAmbulancier & " / Date en colonne " & Colonnedujour _
                    & vbCrLf & vbCrLf & _
                    "La valeur copié sera " & CopieCalcul & ".")
 
Cells(NomAmbulancier, Colonnedujour).Select 
 
ProtectSheet
 
End Sub

[MicKRub]

Bonjour la communauté,

Je me permet de crier à l'aide pour mon problème. Je ne sais pas du tout comment faire.

Merci à vous.

J'ai essayé d'adapter votre code mais ça ne marche pas. cela me met Erreur définie par l'application ou définie par l'objet ici,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(NomAmbulancier, Colonnedujour).Select

Ensuite j'aimerai arriver une cellule en dessous de celle sélectionner via

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(NomAmbulancier, Colonnedujour).Select

Et y copier mon résultat de calcul

J'ai fait un test avec un MsgBox et cela me retourne bien des valeurs.
Exemple si je met 01.01.2018 et ambulancier 1, mon message box me retourne Nom en ligne 49 / Date en colonne 29

Merci beaucoup de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
 
Private Sub Bouton_Valider_Click()
Dim DateRecherchee As Date
Dim NomRecherche As String
Dim Nomfichier As String
 
Dim NomAmbulancier As String
Dim Colonnedujour As String
 
Dim CopieCalcul As String
 
DateRecherchee = Me.MaDate.Value
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
 
CopieCalcul = Me.ResultatHS.Caption
 
Application.ScreenUpdating = False
 
UnprotectSheet
 
NomAmbulancier = Worksheets("2018").Range("AA25:AA183").Find(NomRecherche, lookat:=xlValue).Row
Colonnedujour = Worksheets("2018").Range("AB11:ACD11").Find(DateRecherchee, lookat:=xlValue).Column
 
MsgBox ("Nom en ligne " & NomAmbulancier & " / Date en colonne " & Colonnedujour _
                    & vbCrLf & vbCrLf & _
                    "La valeur copié sera " & CopieCalcul & ".")
 
Cells(NomAmbulancier, Colonnedujour).Select 
 
ProtectSheet
 
End Sub

[Invité]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim dicoDate As Object, dicoAgents As Object
 
Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("Feuil1").Cells(dicoAgents(Me.ComboBox1.Value), dicoDate(CDate(TextBox1))) = "X"
End Sub
 
 
Private Sub UserForm_Initialize()
Set dicoDate = CreateObject("Scripting.Dictionary")
Set dicoAgents = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Feuil1").UsedRange
    For C = 2 To .Columns.Count
       dicoDate(.Cells(2, C).Value) = C
    Next
     For l = 3 To .Rows.Count
       dicoAgents(.Cells(l, 1).Value) = l
    Next
   Me.ComboBox1.List = Range(.Cells(2, 1), .Cells(.Rows.Count, 1)).Value
End With
TextBox1 = "01/01/2017": Me.ComboBox1.ListIndex = 1
End Sub

[MicKRub]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim dicoDate As Object, dicoAgents As Object
 
Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("Feuil1").Cells(dicoAgents(Me.ComboBox1.Value), dicoDate(CDate(TextBox1))) = "X"
End Sub
 
 
Private Sub UserForm_Initialize()
Set dicoDate = CreateObject("Scripting.Dictionary")
Set dicoAgents = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Feuil1").UsedRange
    For C = 2 To .Columns.Count
       dicoDate(.Cells(2, C).Value) = C
    Next
     For l = 3 To .Rows.Count
       dicoAgents(.Cells(l, 1).Value) = l
    Next
   Me.ComboBox1.List = Range(.Cells(2, 1), .Cells(.Rows.Count, 1)).Value
End With
TextBox1 = "01/01/2017": Me.ComboBox1.ListIndex = 1
End Sub

Merci pour votre exemple,

Malheureusement je n'arrive pas (ne comprends pas comment) l'intégré dans ma situation.

[MarcelG]

Bonjour,

Si je peux me permettre dysorthographie, juste un détail.

Ne gagnerait-on pas à déclarer les dictionnaires tels quels

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim mondico as New Scripting.Dictionary

Ce qui permet, en saisie semi-automatique, d'avoir accès à toutes les méthodes et propriétés des dictionnaires.

[Invité]

si mais il faut bricoler le référence au risque d'avoir des problèmes de versions en passant d'une machine à une autre! c'est pour cela que j'évite ce genre de déclaration.

Merci pour votre exemple,

Malheureusement je n'arrive pas (ne comprends pas comment) l'intégré dans ma situation.

dessolé je pensai avoir mis un fichier d'exemple en pièce jointe!

[MarcelG]

il faut bricoler le référence

Excuse-moi mais je ne vois pas.

[Invité]

[MarcelG]

Ok. Je pensais à une version de Library.
Je n'ai pas ce cas pour les utilisateurs de mes applicatifs.

[MicKRub]

si mais il faut bricoler le référence au risque d'avoir des problèmes de versions en passant d'une machine à une autre! c'est pour cela que j'évite ce genre de déclaration.



dessolé je pensai avoir mis un fichier d'exemple en pièce jointe!

Si si il y avait bien un fichier. J'ai essayer de comprendre comment l'adapter à mon cas mais je ne comprend pas. (je cherche sûrement à faire quelque chose qui dépasse mes capacités).

Je vais essayé de vous expliquer au mieux.

1. Dans ma feuille "2018", j'ai tous les mois qui y sont afficher. Chaque jour est composé de deux colonnes (pour l'horaire de jour et de nuit)
   
2. En lignes 11 j'ai toutes les dates de chaque jours, doublées donc... de AB11 à ACD11.
   
3. La listes des ambulanciers est afficher dans une feuille nommée "Listes" de la colonne B de la ligne B9 à B44.
   Donc je peux donné ces valeurs à ma Combobox de mon UserForm "New_HS" nommée ChoixAmbu

   Code :

   Sélectionner tout - Visualiser dans une fenêtre à part

   ChoixAmbu.List = Worksheets("Listes").Range("B9:B44").Value

Maintenant dans mon UserForm "New_HS" j'aimerai que lorsque je clique sur le bouton [Validé H.S.] cela note le résultat de mon calcul d'heure, MAIS une ligne en dessous de la ligne correspondant au nom de l'ambulancier (comme fait manuellement sur l'image ci-dessous)



Actuellement avec le code du bouton [Validé H.S.] j'ai mis une MsgBox pour voir les valeurs que cela retour



Pour mon exemple: Nom Ambulancier 2, Date 03.01.2018. Cela me retour, nom en Ligne 53 et date en colonne 33, ce qui est correct bien que je souhaite arrivé en ligne 54 pour y noté mon résultat de calcul.

Cela me met une erreur d’exécution "1004"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Private Sub Bouton_Valider_Click()
Dim DateRecherchee As Date
Dim NomRecherche As String
Dim Nomfichier As String
 
Dim NomAmbulancier As String
Dim Colonnedujour As String
 
Dim CopieCalcul As String
 
'On Error Resume Next
 
DateRecherchee = Me.MaDate.Value
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
CopieCalcul = Me.ResultatHS.Caption
 
Application.ScreenUpdating = False
 
 
UnprotectSheet
 
NomAmbulancier = Worksheets("2018").Range("AA25:AA183").Find(NomRecherche, lookat:=xlValue).Row
Colonnedujour = Worksheets("2018").Range("AB11:ACD11").Find(DateRecherchee, lookat:=xlValue).Column
 
MsgBox ("Nom en ligne " & NomAmbulancier & " / Date en colonne " & Colonnedujour _
        & vbCrLf & vbCrLf & _
        "La valeur copié sera " & CopieCalcul & ".")
 
 
Cells(NomAmbulancier, Colonnedujour).Select
 
ProtectSheet
 
End Sub

Voilà voilà, j'espère ne pas trop vous embêter et que quelqu'un pourra m'aider.

C'est la dernière chose que j'aimerai faire pour finir mon fichier et l'utilisé pour préparer l'année prochaine.

Salutations et merci.

[Invité]

dans b2 jai la valeur 01/01/2017 au format jj
dans C2 j'ai la formule =B2+1; D2=C2+1; etc...au format jj
dans B1 =MOIS(B2) au format Mmmm
dans initialisation du UserForm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 For C = 2 To .Columns.Count
       dicoDate(.Cells(2, C).Value) = C
    Next

dicoDate("01/01/2017") =2 c'est dans mon exemple la colonne 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For l = 3 To .Rows.Count
       dicoAgents(.Cells(l, 1).Value) = l
    Next

dicoAgents("Tous ceux qui le veulent") =5 toujours dans mon exemple
cells(dicoDate("01/01/2017") ,dicoAgents("Tous ceux qui le veulent")) ces la cellule cells(5,2)