Discussion :

[Bricoltou]

Bonsoir le Forum

J'ai creer une Macro avec votre aide et j'essaie de modifier mon code pour un autre dossier mais le code bloque sur la fonction et je ne vois pas l'erreur .
Je voudrai que les valeurs de mes textBox se reporte dans le tableau a la date choisi .
Les cellules couleur represente un evenement d'absence pour la personne et sont creer par une macro d'une autre saisie .
Merci d'avance pour votre aide .
Meilleurs voeux à tous , santé bonheur et beaucoup de joie
@+
Bricoltou

[Bricoltou]

Bonsoir le Forum

Suite au message de Pierre ci joint mon code
Merci pour 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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Private Sub CommandButton2_Click()
Unload Me
End Sub
 
Private Sub CommandButton3_Click()
Workbooks.Open Filename:= _
"K:\Pilotage\Camionnage\Heures_chauffeurs_mensuel.xls"
col = recherchemot("b6:az6", Me.CbBox_choixjour.Value, 4)
'affectation des valeurs pour titulaires
For i = 1 To 28
With Me.Controls("ComboBox" & i)
    If .ListIndex > -1 And Me.Controls("ComboBox" & 12 + i).ListIndex > -1 Then
        lig = recherchemot("b9:b39", .Value, Me.ComboBox.Value, 1)
        If lig > 0 Then
Saisie_heure.Hide
End Sub
 
Private Sub UserForm_Initialize()
With Sheets("SD")
Dim i As Integer, j As Integer, K As Integer
Dim y As Byte
For i = 2 To .Range("W65000").End(xlUp).Row 'affectation des combobox feuilles saisie heure
        If .Cells(i, 1) <> .Cells(i - 1, 23) Then 'chauffeur
            For y = 1 To 28
                Me.Controls("CbBoxheure" & y).AddItem .Cells(i, 23).Value
            Next y
        End If
    Next i
For K = 2 To .Range("Y65000").End(xlUp).Row 'Date
        If .Cells(K - 1, 1) <> .Cells(K, 25) Then CbBox_choixjour.AddItem .Cells(K, 25).Value
    Next K
 
For y = 1 To 25
On Error Resume Next 'pour éviter le bug si il y a moins de données que de comboboxes...
Me.Controls("CbBoxheure" & y).ListIndex = y - 1 'affiche la première valeur de la ComboBox
Next y
End With
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : recherchemot
' Utilisation   :
' dim lig as long
'lig =recherchemot(plage_pour la recherche,valeur_cherché,nom_de_la_feuille, code_retour )
' ad plage de recherche
'ad = "a2:" & Sheets("rue").Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0) ' on recherche dans l'ensemble de la feuille
'col1 = recherchemot("A1:IV11", data1, nomfeuille1, 2)
' pour extraire le code de la colonne
 
'---------------------------------------------------------------------------------------
'
Function recherchemot(plage_recherche As String, valcherche As Variant, nom_de_la_feuille As String, code_retour As Byte)
'Dim firstAddress As String
Dim £cel As Range
'Dim ligne1 As Long
'Dim ligne2 As Long
Dim £i As Integer
 
With Sheets(nom_de_la_feuille).Range(plage_recherche)
     Set £cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByColumns, lookat:=xlWhole) ' on recherche ligne par ligne
 If Not £cel Is Nothing Then
 
         If code_retour = 1 Then recherchemot = £cel.Row
         If code_retour = 2 Then recherchemot = £cel.Address(0, 0)
         If code_retour = 3 Then recherchemot = £cel.Column
         If code_retour = 4 Then
            For £i = 1 To Len(£cel.Address(0, 0))
                If IsNumeric(Mid(£cel.Address(0, 0), £i, 1)) Then Exit For
                recherchemot = recherchemot & Mid(£cel.Address(0, 0), £i, 1)
            Next £i
         End If
        Exit Function
    End If
End With
If code_retour = 1 Then recherchemot = 0
If code_retour = 2 Then recherchemot = ""
If code_retour = 3 Then recherchemot = 0
If code_retour = 4 Then recherchemot = ""
End Function
 
End Function

[Gorfael]

Salut Bricoltou et Bonne et heureuse année à tous
Déjà, avec ton code, on peut travailler. Mais sans le but il faut reconstituer l'algo alors que tu peux le fournir. La ligne en erreur ainsi que le type d'erreur, c'est pas mal aussi
J'ai juste refais les indentation de ta Function, et je trouve un endif en trop

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
Function recherchemot(plage_recherche As String, valcherche As Variant, nom_de_la_feuille As String, code_retour As Byte)
'Dim firstAddress As String
Dim £cel As Range
'Dim ligne1 As Long
'Dim ligne2 As Long
Dim £i As Integer
 
With Sheets(nom_de_la_feuille).Range(plage_recherche)
    Set £cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByColumns, lookat:=xlWhole) ' on recherche ligne par ligne
    If Not £cel Is Nothing Then
        If code_retour = 1 Then recherchemot = £cel.Row
        If code_retour = 2 Then recherchemot = £cel.Address(0, 0)
        If code_retour = 3 Then recherchemot = £cel.Column
        If code_retour = 4 Then
        For £i = 1 To Len(£cel.Address(0, 0))
            If IsNumeric(Mid(£cel.Address(0, 0), £i, 1)) Then Exit For
            recherchemot = recherchemot & Mid(£cel.Address(0, 0), £i, 1)
        Next £i
    End If
    Exit Function
End With
If code_retour = 1 Then recherchemot = 0
If code_retour = 2 Then recherchemot = ""
If code_retour = 3 Then recherchemot = 0
If code_retour = 4 Then recherchemot = ""
End Function

Faut arrêter de penser que l'indentation sert à l'esthétique du code : c'est un outil qui permet de voir où on en est dans les boucle, test, etc. Mais quelque soit la qualité d'un outil, si elle est entre des mains inexpérimentées...

Juste quelques remarques sur le code fourni :

Code :

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

1
2
3
4
5
6
Private Sub CommandButton3_Click()
Workbooks.Open Filename:= _
"K:\Pilotage\Camionnage\Heures_chauffeurs_mensuel.xls"
col = recherchemot("b6:az6", Me.CbBox_choixjour.Value, 4)
'affectation des valeurs pour titulaires
For i = 1 To 28

Pas de déclaration pour i ?

Code :

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

1
2
3
4
5
6
Private Sub UserForm_Initialize()
With Sheets("SD")
Dim i As Integer, j As Integer, K As Integer
Dim y As Byte
For i = 2 To .Range("W65000").End(xlUp).Row 'affectation des combobox feuilles saisie heure
        If .Cells(i, 1) <> .Cells(i - 1, 23) Then 'chauffeur

Tu déclares i en entier et tu le fait aller de 2 à 65000 (au maximum). Il n'y a plus qu'à espérer que i n'atteigne ou ne dépasse jamais 32767, parce que tu auras un dépassement de capacité. Et ça se produira dans longtemps et sans raison apparente, et à un moment crucial (Loi de LEM)
Mais tu as économisé 2 octets, que dis-je 6 octets essentiels pour ton code. T'as combien de RAM ?
Prévois tes variables de manière à ce qu'elles fonctionnent encore correctement avec la valeur la plus grande possible qu'elles puissent recevoir, même si c'est réellement improbable. Mais avoir un dépassement de capacité parce qu'une erreur de manip a mis un espace en ligne 65536, même si c'est improbable, ne doit pas déclencher une erreur.

J'avoue, je porte des lunettes :

Code :

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

.Cells(i, 1)

J'ai du mal, surtout si je recherche une panne vers 3heure du matin, à ne pas confondre i ou I et 1. Même si on code souvent en i/j les axes, je préfère x/y, qui me semblent beaucoup plus lisibles. Mais ce n'est qu'une opinion personnelle.
A+

[Bricoltou]

Bonjour Le Forum ,Gorfael

Merci pour ta réponse trés complète , mais j'avoue ne pas avoir tout compris .
Peux tu m'expliquer comment je dois modifier mon code car j'ai fait des essais
et cela ne fonctionne pas .

Merci encore pour ton aide