[VBA] Erreur 6 dépassement de capacité

Le 21/03/2017 à 08:21

Bonjour à tous,

Après avoir finalisé le codage de mon fichier test, j'ai transféré celui-ci sur le fichier final qu'on utilise au travail.

Pour faire une brève explication de mon fichier, un formulaire permet de choisir l'axe du chantier (choix de l'axe) puis, la nature des travaux en fonction de l'axe choisi : la problématique étant que la nature des travaux peuvent correspondre à plusieurs axes.

Ensuite, on choisi la date d'application puis on clique sur valider.

170321083603797805

Au final, cela met en surbrillance la case à modifier pour aide l'opérateur.

170321083906427162

Mon problème étant que mon fichier final est à cheval sur deux années, précisément du 18/12/16 au 30/06/2017. De ce fait, à chaque fois que je valide le formulaire j'ai une erreur de dépassement de capacité. Qui renvoi à cette ligne :

lalign = t.Row

Comme je le sais, le problème vient que excel ne peut calculer que de -32768 à 32767. Alors qu'ici j'ai des nombres bien supérieur : le 18/12/2016 qui correspond au 42722... J'ai donc essayé de modifier mes déclarations avec "LONG". Là, le formulaire se validait, je n'avais plus d'erreur mais également plus de surbrillance dans mon fichier.

Du coup je vous laisse mon codage si vous trouvez une erreur que je n'aurais pas vu.

Je vous remercie par avance, cordialement,

Baptiste Kerdraon.

Option Explicit

Private Sub Find1S1_Initialize()

Dim dico As Variant
Set dico = CreateObject("Scripting.Dictionary")

'Initialisation de la Combobox
Cbx_version.Clear

Dim c As Range

'Remplir nom de la page + nom de la liste 
For Each c In Worksheets("Commande 2017 DECEMBRE A JUIN").Range("Marche_S1")
        With c
                If Not dico.Exists(.Value) Then
                        dico.Add .Value, .Value
                        Cbx_version.AddItem .Value
                End If
        End With
Next c

'dictionnaire réinitialisé
dico.RemoveAll
'libération de la variable
Set dico = Nothing

End Sub
Private Sub Cbx_version_Change()

Call alim_combo_note(Cbx_version.Value)

End Sub
Public Sub alim_combo_note(maversion As String)

If maversion = "" Then Exit Sub

Dim c As Range
Dim firstAddress As Variant

'Vider la Combobox des items précédents
Cbx_note.Clear
'Recherche de la version pour alimenter les items de la note

'Remplir nom de la page + nom de la liste des trains
With Worksheets("SA 2017 DECEMBRE A JUIN").Range("Marche_S1")
        Set c = .Find(maversion, LookIn:=xlValues, Lookat:=xlWhole)
        'Alimentation des items
        firstAddress = c.Address
        Do
                Cbx_note.AddItem c.Offset(0, 1).Value
                Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
End With

'Libération de la variable
Set c = Nothing

'Facultatif : Tri le contenu de la ComboBox par ordre alphabétique

Dim i As Integer, j As Integer, strtemp As String

With Cbx_note
        For i = 0 To .ListCount - 1
                For j = 0 To .ListCount - 1
                        If .List(i) < .List(j) Then
                                strtemp = .List(i)
                                .List(i) = .List(j)
                                .List(j) = strtemp
                        End If
                Next j
        Next i
End With

End Sub
 Private Sub Btn_Recherche_Click()

Dim ladate As Date

ladate = CDate(Cbx_jour.Text & " " & Cbx_mois.Text & " " & Cbx_annee.Text)

Dim c As Range
Dim lacolonne As Range
Dim t As Range
Dim lalign As Byte
Dim Rang As String

    'Nommer la feuille utilisee
    With Worksheets("Commande 2017 DECEMBRE A JUIN")
        'Nom plage de date
        Set c = .Range("date_test").Find(ladate, LookIn:=xlFormulas)
        'Nom plage de la liste
        Set lacolonne = .Range("Marche_S1").Offset(0, c.Column - .Range("Marche_S1").Column)
        For Each t In lacolonne
            lalign = t.Row
                If Trim(.Range("A" & lalign).Value) = Cbx_version.Value And Trim(.Range("B" & lalign).Value) = Cbx_note.Value Then
                Rang = "" & Split(t.Address, "$")(1) & ":" & Split(t.Address, "$")(1) & "," & t.Row & ":" & t.Row & ""
                Range(Rang).Select
                Exit For
                End If
        Next t
    End With
        Unload Me
    End Sub
Le 22/03/2017 à 06:47

Bonjour,

Déjà, un point peut poser problème dans cette proc :

Public Sub alim_combo_note(maversion As String)

If maversion = "" Then Exit Sub

Dim c As Range
Dim firstAddress As Variant

'Vider la Combobox des items précédents
Cbx_note.Clear
'Recherche de la version pour alimenter les items de la note

'Remplir nom de la page + nom de la liste des trains
With Worksheets("SA 2017 DECEMBRE A JUIN").Range("Marche_S1")
        Set c = .Find(maversion, LookIn:=xlValues, Lookat:=xlWhole)
        'Alimentation des items
       firstAddress = c.Address
        Do
                Cbx_note.AddItem c.Offset(0, 1).Value
                Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
End With

'Libération de la variable
Set c = Nothing

'Facultatif : Tri le contenu de la ComboBox par ordre alphabétique

Dim i As Integer, j As Integer, strtemp As String

With Cbx_note
        For i = 0 To .ListCount - 1
                For j = 0 To .ListCount - 1
                        If .List(i) < .List(j) Then
                                strtemp = .List(i)
                                .List(i) = .List(j)
                                .List(j) = strtemp
                        End If
                Next j
        Next i
End With

End Sub

et particulièrement ici :

With Worksheets("SA 2017 DECEMBRE A JUIN").Range("Marche_S1")
        Set c = .Find(maversion, LookIn:=xlValues, Lookat:=xlWhole)
        'Alimentation des items
       firstAddress = c.Address
        Do
                Cbx_note.AddItem c.Offset(0, 1).Value
                Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
End With

car tu recherches une valeur et ensuite, sans contrôler si Find() retourne bien un Range tu affectes l'adresse de ce Range à ta variable, si rien n'est trouvé Find() mets ta variable "c" à Nothing donc erreur !

Je ferai plutôt comme ceci :

'Remplir nom de la page + nom de la liste des trains
With Worksheets("SA 2017 DECEMBRE A JUIN").Range("Marche_S1")
        Set c = .Find(maversion, LookIn:=xlValues, Lookat:=xlWhole)

        If Not c Is Nothing Then
            'Alimentation des items
            firstAddress = c.Address

            Do
                    Cbx_note.AddItem c.Offset(0, 1).Value
                    Set c = .FindNext(c)
            Loop While c.Address <> firstAddress

        Else

            Exit Sub '<--- évite la procédure de tri puisqu'il n'y a rien à trier !

        End If

End With

Un autre point maintenant dans la proc ci-dessous :

 Private Sub Btn_Recherche_Click()

Dim ladate As Date

ladate = CDate(Cbx_jour.Text & " " & Cbx_mois.Text & " " & Cbx_annee.Text)

Dim c As Range
Dim lacolonne As Range
Dim t As Range
Dim lalign As Byte
Dim Rang As String

    'Nommer la feuille utilisee
   With Worksheets("Commande 2017 DECEMBRE A JUIN")
        'Nom plage de date
       Set c = .Range("date_test").Find(ladate, LookIn:=xlFormulas)
        'Nom plage de la liste
       Set lacolonne = .Range("Marche_S1").Offset(0, c.Column - .Range("Marche_S1").Column)
        For Each t In lacolonne
            lalign = t.Row
                If Trim(.Range("A" & lalign).Value) = Cbx_version.Value And Trim(.Range("B" & lalign).Value) = Cbx_note.Value Then
                Rang = "" & Split(t.Address, "$")(1) & ":" & Split(t.Address, "$")(1) & "," & t.Row & ":" & t.Row & ""
                Range(Rang).Select
                Exit For
                End If
        Next t
    End With
        Unload Me
    End Sub

Dans la recherche de dates, je trouve Find() assez capricieuse donc, afin de voir si ça vient de là, je te propose de tester ce qui suit donc, à la place de :

'Nom plage de date
Set c = .Range("date_test").Find(ladate, LookIn:=xlFormulas)

je te propose ceci pour voir :

'Nom plage de date
For Each c In .Range("date_test")

    'si la valeur est la même, fin de boucle
    If c.Value2 = CLng(ladate) Then Exit For

Next c
Le 22/03/2017 à 08:08

Bonjour Theze.

Merci pour ces corrections !

Lorsque j'exécute avec tes corrections j'ai de nouveau l'erreur qui pointe sur :

lalign = t.Row

Du coup ne serait-ce pas une erreur de déclaration ?

Dim lalign As Byte

J'avais tester avec Long et Integer, là plus d'erreur mais plus de croisement en surbrillance non plus

Pour te donner une idée, mes plages de cellules :

> Marche_S1 = $B$5:$B$356

> date_test = $G$4:$GS$4

Cordialement et merci de ton aide.

Baptiste K.

Le 22/03/2017 à 17:28

Re,

Byte c'est maximum 255

Je dois partir mais je regarde ça un peu plus tard dans la soirée !

Le 23/03/2017 à 07:55

Bonjour,

C'est en effet ce que j'avais vu après coup pour "Byte".

En tout cas merci Theze

Rechercher des sujets similaires à "vba erreur depassement capacite"