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

[Invité]

les cellules fusionnées ne posent pas de problème dès l’instant ou on à compris que la fusion est toujours en haut à gauche du bloc fusionnée!

Tu réajustes à l'offset qui est pareil en lignes et en colonnes que la fusion!

cells(dicoDate("01/01/2017") ,dicoAgents("Tous ceux qui le veulent")).Offset(1,1)Si il format ces cellules pour afficher de dates jj pour les jours mmmm pour les mois alors chaque jour est une date comme dans mon exemple et il ne ce souci pas du mois!

[patricktoulon]

ces cellules ne sont bpas formatées se sont bien des nombres de 01 a 31
et il y en a donc 12 de chaque sur la même ligne
le seul répare que tu a a dispo c'est la cellule fusionnée de chaque mois pour cerner quel jour 15 par exemple va avec quel mois
ou compter la n eme cellule avec 15 par exemple pour en connaitre le mois la 3 eme c'est mars la 4eme c'est avril etc........mais c'est moins sur vu le tableau qu'il a montrer en image je soupçonne des fusions a gogo

[MicKRub]

ces cellules ne sont bpas formatées se sont bien des nombres de 01 a 31
et il y en a donc 12 de chaque sur la même ligne
le seul répare que tu a a dispo c'est la cellule fusionnée de chaque mois pour cerner quel jour 15 par exemple va avec quel mois
ou compter la n eme cellule avec 15 par exemple pour en connaitre le mois la 3 eme c'est mars la 4eme c'est avril etc........mais c'est moins sur vu le tableau qu'il a montrer en image je soupçonne des fusions a gogo

Effectivement j'ai fusionné plusieurs cellules.

Voici une image qui pourra peut-être vous aider à comprendre ce que j'ai fait (erreur peut-être)


Mes dates son en ligne 11.
En ligne 12, ce sont des cellules fusionnées mais avec un format personnalisé en jj -> 01.
En ligne 14, ce sont des cellules fusionnées mais avec un format personnalisé en jj -> 01. la valeur de AC12 est =AC11, AE12 = AC12+1, AG12 = AE12+1, etc...
En ligne 16, ce son tdes cellules fusionnées mais avec un format personnalisé en jjj -> Lun. Même chose ici.
En ligne 17 ,ce sont des cellules fusionnées mais avec un format personnalisé en jj ->01. Même chose ici.

Les lignes Heures supp. sont fusionnées avec un format personnalisé en [hh]:mm. Serait-il mieux de ne pas les fusionner?



Pensez-vous qu'il y a une possibilité de faire ce que je souhaite en état actuel de ma feuille 2018?

Cordialement

[MicKRub]

A dysorthographie et patricktoulon,

Merci pour le temps que vous passez à m'aider.

dysorthographie, je vais analysé ce que vous m'avez écrit.

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
4
 
 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
4
5
6
 
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)

Et essayé de l'adapter a ma situation.

Un grand merci à vous

[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

[Invité]

Si tu as la possibilité de joindre un fichier en bidonnant les datas on serait plus a laisse!

[MicKRub]

Si tu as la possibilité de joindre un fichier en bidonnant les datas on serait plus a laisse!

Qu'entendez vous de, en bidonnant les datas?

Je peux sans autre vous joindre mon fichier.

Merci

[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é]

Bonjour,

https://mon-partage.fr/f/w94W8dgL/

Code UserForm_Initialize :

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
Private Sub UserForm_Initialize()
Dim C As Integer, L As Integer
    New_HS.Bouton_Reset = True
    Me.Label_Nom.Caption = ""
    ChoixAmbu.List = Worksheets("Listes").Range("B9:B44").Value
 Set dicoDate = CreateObject("Scripting.Dictionary")
Set dicoAgents = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("2018").UsedRange
    For C = 0 To 364
   Debug.Print .Cells(12, 29).Offset(0, C).Value
     If CStr("" & (.Cells(12, 29).Offset(0, C).Value)) <> "" Then dicoDate(.Cells(12, 29).Offset(0, C).Value) = .Cells(12, 29).Offset(0, C).Column
    Next
     For L = 25 To .Rows.Count
     Debug.Print .Cells(L, 27).Value
      If CStr("" & .Cells(L, 27).Value) <> "" Then dicoAgents(.Cells(L, 27).Value) = L
    Next
 
End With
End Sub

Code Bouton_Valider_Click :

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
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub Bouton_Valider_Click()
Dim DateRecherchee As Date
Dim NomRecherche As String
Dim Nomfichier As String
 
 
Dim NomAmbulancier As Integer
Dim Colonnedujour As Integer
 
 
Dim CopieCalcul As String
 
 
'On Error Resume Next
 
 
DateRecherchee = Me.MaDate
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
CopieCalcul = Me.ResultatHS.Caption
 
 
Application.ScreenUpdating = False
 
 
 
 
UnprotectSheet
 
 
NomAmbulancier = dicoAgents(NomRecherche)
Colonnedujour = dicoDate(DateRecherchee)
 
 
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,

https://mon-partage.fr/f/w94W8dgL/

Code UserForm_Initialize :

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
Private Sub UserForm_Initialize()
Dim C As Integer, L As Integer
    New_HS.Bouton_Reset = True
    Me.Label_Nom.Caption = ""
    ChoixAmbu.List = Worksheets("Listes").Range("B9:B44").Value
 Set dicoDate = CreateObject("Scripting.Dictionary")
Set dicoAgents = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("2018").UsedRange
    For C = 0 To 364
   Debug.Print .Cells(12, 29).Offset(0, C).Value
     If CStr("" & (.Cells(12, 29).Offset(0, C).Value)) <> "" Then dicoDate(.Cells(12, 29).Offset(0, C).Value) = .Cells(12, 29).Offset(0, C).Column
    Next
     For L = 25 To .Rows.Count
     Debug.Print .Cells(L, 27).Value
      If CStr("" & .Cells(L, 27).Value) <> "" Then dicoAgents(.Cells(L, 27).Value) = L
    Next
 
End With
End Sub

Code Bouton_Valider_Click :

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
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub Bouton_Valider_Click()
Dim DateRecherchee As Date
Dim NomRecherche As String
Dim Nomfichier As String
 
 
Dim NomAmbulancier As Integer
Dim Colonnedujour As Integer
 
 
Dim CopieCalcul As String
 
 
'On Error Resume Next
 
 
DateRecherchee = Me.MaDate
NomRecherche = Me.ChoixAmbu.Value
Nomfichier = ThisWorkbook.Name
Nomfichier = Left(Nomfichier, Len(Nomfichier) - 5)
CopieCalcul = Me.ResultatHS.Caption
 
 
Application.ScreenUpdating = False
 
 
 
 
UnprotectSheet
 
 
NomAmbulancier = dicoAgents(NomRecherche)
Colonnedujour = dicoDate(DateRecherchee)
 
 
MsgBox ("Nom en ligne " & NomAmbulancier & " / Date en colonne " & Colonnedujour _
        & vbCrLf & vbCrLf & _
        "La valeur copié sera " & CopieCalcul & ".")
 
 
 
 
Cells(NomAmbulancier, Colonnedujour).Select
 
 
ProtectSheet
 
 
End Sub

Merci dysorthographie,

Je viens de voir voir fichier et je vais prendre le temps de le comprendre.

J'ai réussi à faire ce que je voulais en adaptant ce que patricktoulon m'avais proposé.

Votre calendrier pourrai m'être utile.

Merci à vous deux.

Meilleures salutations

[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!