Erreur dans la déclaration de tableau

**adaoluz** · 15/08/2018, 07h15

Salut les amis, bonsoir!
J'essaie de développer une fiche de travail sur la réservation de véhicules

mais j'ai trouvé difficile de créer une matrice dans le forum ci-dessous, cela donne des erreurs
de variable non définie "Jr_Feries", merci de vous aider de quelqu'un, suivez le code ci-dessous., merci à tous ceux qui peuvent m'aider.

Code :

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

1
2
3
4
5
6
7
8
Option Explicit
 
Public Date_calendar As String
Public ChoixDate As Date
Public Txt_dt As Integer
Public USF As Object
Public Date_initiale As String
Public dt0 As Date

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
' ** http://excel.developpez.com/faq/index.php?page=Form#UFnoTitle ********************************
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Const SWP_FRAMECHANGED = &H20
 
#If VBA7 Then
    Public Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Public Declare PtrSafe Function GetWindowRect Lib "user32" _
        (ByVal hwnd As Long, lpRect As RECT) As Long
 
    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias _
        "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias _
        "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
 
    Public Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
        ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
        ByVal wFlags As Long) As Long
#Else
    Public Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Public Declare Function GetWindowRect Lib "user32" _
        (ByVal hwnd As Long, lpRect As RECT) As Long
 
    Public Declare Function GetWindowLong Lib "user32" Alias _
        "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
    Public Declare Function SetWindowLong Lib "user32" Alias _
        "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
 
    Public Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
        ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
        ByVal wFlags As Long) As Long
#End If

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
Sub Affiche(oUSF As Object, oControl As String, Optional oFrame As String)
Dim T As Single, L As Single
 
    If Not oFrame = "" Then
        T = oUSF.Controls(oFrame).Top + 17
        L = oUSF.Controls(oFrame).Left
    End If
 
    Set USF = oUSF
    Date_initiale = oUSF.Controls(oControl).Value
    Txt_dt = Replace(oUSF.Controls(oControl).Name, "TextBox", "")
 
    With Calendrier
        .Top = oUSF.Top + T + oUSF.Controls(oControl).Top _
               + oUSF.Controls(oControl).Height * 2 + 3
        .Left = oUSF.Left + L + oUSF.Controls(oControl).Left
        .Show
    End With
End Sub
 
Sub init_Feries(Annee As Integer)
Dim d0 As Date, i As Integer
 
    Jr_Feries = Array("Premier de l'An", "Pâques", "Lundi de Pâques", "Fête du Travail", _
         "Victoire 1945", "Ascension", "Pentecôte", "Lundi de Pentecôte", "Fête Nationale", _
         "Assomption", "Toussaint", "Armistice", "Noël", "Premier de l'An", "Pâques", _
         "Lundi de Pâques", "Fête du Travail", "Victoire 1945", "Ascension", "Pentecôte", _
         "Lundi de Pentecôte", "Fête Nationale", "Assomption", "Toussaint", "Armistice", "Noël")
 
    Dt_Feries(0) = DateSerial(Annee, 1, 1)
    d0 = DateSerial(Annee, 4, ((234 - 11 * (Annee Mod 19)) Mod 30))
    i = (d0 - DateSerial(1899, 12, 31)) / 7
    Dt_Feries(1) = CDate(Math.Round(i) * 7 - 6)
    Dt_Feries(2) = DateAdd("d", 1, Dt_Feries(1))
    Dt_Feries(3) = DateSerial(Annee, 5, 1)
    Dt_Feries(4) = DateSerial(Annee, 5, 8)
    Dt_Feries(5) = DateAdd("d", 39, Dt_Feries(1))
    Dt_Feries(6) = DateAdd("d", 49, Dt_Feries(1))
    Dt_Feries(7) = DateAdd("d", 1, Dt_Feries(6))
    Dt_Feries(8) = DateSerial(Annee, 7, 14)
    Dt_Feries(9) = DateSerial(Annee, 8, 15)
    Dt_Feries(10) = DateSerial(Annee, 11, 1)
    Dt_Feries(11) = DateSerial(Annee, 11, 11)
    Dt_Feries(12) = DateSerial(Annee, 12, 25)
 
    Dt_Feries(13) = DateSerial(Annee + 1, 1, 1)
    d0 = DateSerial(Annee + 1, 4, ((234 - 11 * ((Annee + 1) Mod 19)) Mod 30))
    i = (d0 - DateSerial(1899, 12, 31)) / 7
    Dt_Feries(14) = CDate(Math.Round(i) * 7 - 6)
    Dt_Feries(15) = DateAdd("d", 1, Dt_Feries(14))
    Dt_Feries(16) = DateSerial(Annee, 5, 1)
    Dt_Feries(17) = DateSerial(Annee, 5, 8)
    Dt_Feries(18) = DateAdd("d", 39, Dt_Feries(14))
    Dt_Feries(19) = DateAdd("d", 49, Dt_Feries(14))
    Dt_Feries(20) = DateAdd("d", 1, Dt_Feries(19))
    Dt_Feries(21) = DateSerial(Annee + 1, 7, 14)
    Dt_Feries(22) = DateSerial(Annee + 1, 8, 15)
    Dt_Feries(23) = DateSerial(Annee + 1, 11, 1)
    Dt_Feries(24) = DateSerial(Annee + 1, 11, 11)
    Dt_Feries(25) = DateSerial(Annee + 1, 12, 25)
End Sub
 
 
Function Est_Ferie(dt As Date)
Dim i As Byte
    Est_Ferie = False
    For i = 0 To UBound(Dt_Feries)
        If dt = Dt_Feries(i) Then
            Est_Ferie = True
            idx_ferie = i
        End If
    Next i
End Function

**parmi** · 15/08/2018, 14h27

Bonjour,

Où as-tu déclaré tes variables tableaux Jr_Feries et Dt_Feries et de quelle façon ?

**adaoluz** · 15/08/2018, 15h01

Bonjour!

se produit l'erreur de variable non définie dans le "Dtferies et jrFeries.", en fait ne pouvait pas déclarer de la manière correcte, pourrait me guider en fait est un tableau.

**parmi** · 15/08/2018, 17h37

Code :

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

1
2
3
4
5
6
7
8
9
 
    Dim Jr_Feries As Variant
    Dim Dt_Feries(25) 'S'il y a toujours 25 (ou 26) items. Autrement voir l'aide pour Redim et Redim Preserve
 
    Jr_Feries = Array("Premier de l'An", "Pâques", "Lundi de Pâques", "Fête du Travail", _
         "Victoire 1945", "Ascension", "Pentecôte", "Lundi de Pentecôte", "Fête Nationale", _
         "Assomption", "Toussaint", "Armistice", "Noël", "Premier de l'An", "Pâques", _
         "Lundi de Pâques", "Fête du Travail", "Victoire 1945", "Ascension", "Pentecôte", _
         "Lundi de Pentecôte", "Fête Nationale", "Assomption", "Toussaint", "Armistice", "Noël")

**adaoluz** · 15/08/2018, 18h35

Je vais tester et je vais vous donner un retour, merci.

**Philippe Tulliez** · 15/08/2018, 19h09

Bonjour,
A lire sur le sujet

**adaoluz** · 15/08/2018, 19h29

Bonjour le code fonctionne très bien, mais a présenté une nouvelle
types incompatibles!!

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
82
83
Private Sub re_init()
Dim Annee As Integer, Mois As Byte, Jour As Byte
Dim Index As Byte, i As Byte, j As Byte, J28 As Date
Dim feries() As Variant, dt As String
 
    Annee = Year(CDate(Me.ddj.Caption))
    Mois = Month(CDate(Me.ddj.Caption))
    Jour = Day(Date)
 
    For i = 1 To 37
        Me.Controls("J" & i).Enabled = True
        Me.Controls("J" & i).ForeColor = &H0
    Next i
 
    For i = 1 To 6
        Me.Controls("sem" & i) = numero_de_semaine(DateSerial(Annee, Mois, 1 + (i - 1) * 7))
    Next i
 
    Me.Label1.Caption = Application.Proper(Format(Me.ddj.Caption, "mmmm yyyy"))
    Index = Weekday(DateSerial(Annee, Mois, 1)) - 1
 
    If Index = 0 Then Index = 7
    For i = 1 To Index - 1
        Me.Controls("J" & i).Caption = ""
        Me.Controls("J" & i).BackColor = &HFFFFFF
    Next i
    For i = Index To 28
        Me.Controls("J" & i).Caption = i - Index + 1
        Me.Controls("J" & i).BackColor = &HFFFFFF
 
            dt = Format(DateSerial(Annee, Mois, i - Index + 1), "dd/mm/yyyy")
                If EstFérié(DateSerial(Year(dt), Month(dt), Me.Controls("J" & i))) = True Then
                    Me.Controls("J" & i).BackColor = RGB(243, 147, 3)   '&HFFC000 '&HE0E0E0
                    Me.Controls("J" & i).ForeColor = &HE0E0E0
                End If
 
        If Not ActiveCell.Value = "" Then 'ActiveCell.Value ou Date_calendar
            If (i - Index + 1) = Day(CDate(Range("E3").Value)) And _
                Mois = Month(CDate(Range("E3").Value)) And _
                Annee = Year(CDate(Range("E3").Value)) Then _
                    Me.Controls("J" & i).BackColor = &HC0C0C0
        End If
        If (i - Index + 1) = Jour And Mois = Month(Date) And Annee = Year(Date) Then _
            Me.Controls("J" & i).BackColor = RGB(208, 207, 196)  '&HFF8080 coloration du jour
    Next i
 
    J28 = DateSerial(Annee, Mois, 28 - Index + 1)
    For i = 29 To 37
        If Month(DateAdd("d", i - 28, J28)) = Mois Then
            Me.Controls("J" & i).Caption = i - Index + 1
            Me.Controls("J" & i).BackColor = &HFFFFFF
 
 
                If EstFérié(DateSerial(Year(dt), Month(dt), Me.Controls("J" & i))) = True Then
                Me.Controls("J" & i).BackColor = RGB(243, 147, 3) '&HE0E0E0
                Me.Controls("J" & i).ForeColor = &HE0E0E0
                End If
 
 
            If Not ActiveCell.Value = "" Then 'ActiveCell.Value ou Date_calendar
            If (i - Index + 1) = Day(CDate(Range("E3").Value)) And _
                Mois = Month(CDate(Range("E3").Value)) And _
                Annee = Year(CDate(Range("E3").Value)) Then _
                    Me.Controls("J" & i).BackColor = &HC0C0C0
            End If
            If (i - Index + 1) = Jour And Mois = Month(Date) And Annee = Year(Date) Then _
                Me.Controls("J" & i).BackColor = RGB(208, 207, 196)  '&HFF8080 coloration du jour
        Else
            Me.Controls("J" & i).Caption = ""
            Me.Controls("J" & i).BackColor = &HFFFFFF
        End If
    Next i
 
        For i = 1 To 37
            If Me.Controls("J" & i).Caption = "" Then
            Me.Controls("J" & i).Enabled = False
            End If
        Next i
 
        'Affichage ou pas de la sem6
        If Me.Controls("J36").Caption <> "30" Or Me.Controls("J36").Caption <> "31" Then sem6.Visible = False 'Masquer sem6
        If Me.Controls("J36").Caption <> "" Then sem6.Visible = True 'Afficher sem6
End Sub

**parmi** · 15/08/2018, 21h59

Désolé, mais je n'ouvre pas les fichiers avec macros.
À quel endroit survient l'erreur?

**adaoluz** · 15/08/2018, 22h12

Envoyé par parmi

Désolé, mais je n'ouvre pas les fichiers avec macros.
À quel endroit survient l'erreur?

Bonjour!
l'erreur donne dans la feuille de travail "Feuil10 (" BD_CAL "), a réellement le calendrier, donne une erreur de type incompatible, le nom de formulaire" Calendrier ", en appuyant sur le" jour "

cette erreur se produit

**parmi** · 15/08/2018, 22h45

Dans ton code du message #7, sur quelle ligne?

**adaoluz** · 15/08/2018, 22h54

Envoyé par parmi

Dans ton code du message #7, sur quelle ligne?

bonjour !

dans cette ligne de code ci-dessous, merci.

Code :

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

1
2
3
4
 If Not ActiveCell.Value = "" Then 'ActiveCell.Value ou Date_calendar
            If (i - Index + 1) = Day(CDate(Range("E3").Value)) And _
                Mois = Month(CDate(Range("E3").Value)) And _
                Annee = Year(CDate(Range("E3").Value)) Then _

**parmi** · 15/08/2018, 23h17

Es-tu certain que Range("E3") contient bien une date?

Pour être certain, tu pourrais mettre un Msgbox ou Debug.print avant cette ligne pour vérifier

Code :

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

Msgbox Month(CDate(Range("E3").Value))

ou encore

Code :

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

Msgbox Range("E3").Value

Comme tu ne spécifies pas de nom de feuille, peut-être que le code regarde une autre feuille que celle que tu penses (?)

**adaoluz** · 16/08/2018, 00h29

Bonjour!

J'ai vérifié ici n'est pas une date dans cette gamme, je voudrais corriger
* malheureusement je ne pouvais pas..

**adaoluz** · 16/08/2018, 15h59

Bonjour, malheureusement je n'ai pas pu corriger l'erreur, si vous pouvez, s'il vous plaît faites le moi savoir!

**parmi** · 16/08/2018, 16h11

Mets ces lignes en commentaire et regarde si le reste passe bien

Code :

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

1
2
3
4
5
6
            If Not ActiveCell.Value = "" Then 'ActiveCell.Value ou Date_calendar
            If (i - Index + 1) = Day(CDate(Range("E3").Value)) And _
                Mois = Month(CDate(Range("E3").Value)) And _
                Annee = Year(CDate(Range("E3").Value)) Then _
                    Me.Controls("J" & i).BackColor = &HC0C0C0
            End If

**adaoluz** · 16/08/2018, 16h20

Merci, je reviendrai bientôt pour l’attention et le dévouement avec lesquels j’ai aidé.

Bonjour, je suis désolé de vous informer que j'ai essayé de toutes les manières de changer les variables

malheureusement je ne pouvais pas

**adaoluz** · 17/08/2018, 15h01

bonjour essayé toutes les solutions possibles, vous avez une autre idée.

Bonjour bonne nuit

Quelqu'un pourrait m'aider dans ce problème, des solutions ont encore été trouvées, qui peuvent gentiment aider merci.

**adaoluz** · 29/08/2018, 16h29

bonjour les amis
Malheureusement, je n'ai pas pu résoudre le problème, quelqu'un pourrait-il m'aider s'il vous plaît?

**adaoluz** · 02/09/2018, 00h26

Quelqu'un pour la gentillesse?
: Oops:: Oops:: Oops:: Oops:

**eriiic** · 02/09/2018, 08h57

Bonjour,

sympa de mettre un fichier qui ferme tous les autres sans demander si on veut sauvegarder...
Ca s'arrêtera donc là pour moi avec toi.
eric

PS : et ma barre de formule, tu passes quand pour me la remettre ?

Erreur dans la déclaration de tableau [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager