Mon code bloque sur la function

Version imprimable

05/01/2010, 21h38
Bricoltou

Mon code bloque sur la function

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 :mrgreen:
@+
Bricoltou

Bonsoir le Forum

Suite au message de Pierre ci joint mon code
Merci pour votre aide

Code:

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

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:

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:

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:

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:

.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+

06/01/2010, 11h40
Bricoltou

Bonjour Le Forum ,Gorfael

Merci pour ta réponse trés complète :ccool:, 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