La méthode 'Value' de l'objet 'Range' a échoué

Le 09/08/2023 à 10:23

Bonjour à tous,

Dans un fichier de suivi, j'ai besoin d'un tableau avec des données sur les salariés.
Comme ce fichier sera utilisé par des personnes ne connaissant pas excel il est important qu'il soit le plus simple d'utilisation possible.
Les utilisateurs devront donc utiliser des userforms pour ajouter des données afin de ne pas mettre de donnée au mauvais endroit.

J'ai ce code suivant qui ajoute un salarié à la feuille "Agents" :

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim i As Integer
    Dim nomprenom As String
    Dim answer As String
    Dim txt As String

    Dim Job As String
    Dim Agence As String
    Dim Nom As String
    Dim Prenom As String
    Dim D As Double

    Set ws = Sheets("Agents")

    Nom = TextNom.Value
    Prenom = TextPrenom.Value
    Agence = ComboBoxAgence.Value
    Job = ComboBoxFonction.Value

    'MsgBox (Agence)

    nomprenom = TextNom.Value & " " & TextPrenom.Value
    nomprenom = UCase(nomprenom)

    'MsgBox ("Contrôle 1")
    'On contrôle les données insérées

    If nomprenom = " " Then
        MsgBox ("Veuillez rentrer un nom/prénom")
        Exit Sub
    End If
    If Job = "" Then
        MsgBox ("Veuillez rentrer une fonction")
        Exit Sub
    End If
    If Agence = "" Then
        MsgBox ("Veuillez rentrer un employeur")
        Exit Sub
    End If
    If Not IsNumeric(TextBoxD.Value) Then
        MsgBox ("La valeur D n'est pas correcte")
        Exit Sub
    End If
    D = CDbl(TextBoxD.Value)

    'MsgBox ("Contrôle 2")
    'Checker si l'agent est déja là
    i = 1
    Do While ws.Cells(i, 3).Value <> nomprenom And ws.Cells(i, 3).Value <> ""

        i = i + 1
    Loop

    If ws.Cells(i, 3).Value = nomprenom Then
        'MsgBox ("L'agent est déjà suivi")
        Exit Sub
    End If
    'MsgBox ("Contrôle 3")

    'Tout est OK donc i contient la première ligne vide
    'On demande une confirmation

    txt = "Ajouter le suivi du collaborateur ?"
    txt = txt & Chr(13) & Chr(10) & Chr(13) & Chr(10)
    txt = txt & "Agent : " & nomprenom
    txt = txt & Chr(13) & Chr(10)
    txt = txt & "Fonction : " & Job
    txt = txt & Chr(13) & Chr(10)
    txt = txt & "Agence : " & Agence
    txt = txt & Chr(13) & Chr(10)
    txt = txt & "D: " & D

    answer = MsgBox(txt, vbQuestion + vbYesNo + vbDefaultButton2, "Alerte")

    If answer = vbYes Then
    'Si l'utilisateur accepte

        ActiveWorkbook.Sheets("Agents").Unprotect

        'Après déverouillage on rajoute une à une les informations

'Repère du bug ___________

        ActiveWorkbook.Sheets("Agents").Range("A" & i).Value = Nom

        ActiveWorkbook.Sheets("Agents").Range("B" & i).Value = Prenom

        ActiveWorkbook.Sheets("Agents").Range("E" & i).Value = Agence

        ActiveWorkbook.Sheets("Agents").Range("F" & i).Value = Job

        ActiveWorkbook.Sheets("Agents").Range("G" & i).Value = D

        'Par défaut autres cases sont numériques et sont vides (0)
        ActiveWorkbook.Sheets("Agents").Range("H" & i & ":L" & i).Value = 0

        'On tri les données ensuite
        On Error Resume Next
        ActiveWorkbook.Worksheets("Agents").ListObjects("TblAgents").Sort.SortFields. _
            Clear
        ActiveWorkbook.Worksheets("Agents").ListObjects("TblAgents").Sort.SortFields. _
            Add2 Key:=Range("TblAgents[[#All],[Nom Prénom]]"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Agents").ListObjects("TblAgents").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        On Error GoTo 0

    'Fin du tri

        ActiveWorkbook.Sheets("Agents").Protect

        MenuWorker.Show
        'On reviens au menu précédent
    End If

End Sub

Le problème c'est que parfois tout se passe bien et puis une fois sur deux, j'ai une erreur :

image

Le fichier se ferme quasiment instantanément après.
Les fois où j'ai pu cliquer sur débogage, la ligne concernée était une des lignes en dessous du repère ajouté en commentaire.
Ce n'est pas toujours la même.

Ce que je ne comprend pas c'est pourquoi ce code fonctionne parfois et parfois non.

J'ai remplacé ws par ActiveWorkbook.Sheets... pour voir si explicité changerai le problème mais non.

Lorsque j'ai cette erreur et que j'arrive à entrer dans le Débogage avant que cela ne crash, je vois bien que mes variables String sont correctement remplies.

Cela fait quelques heures hier et ce matin que je planche dessus sans comprendre pourquoi cela plante.

Si quelqu'un à déjà vu ce problème cela me sauverai.
Merci d'avance pour toute aide que vous pouvez m'offrir.

Le 09/08/2023 à 10:35

Bonjour,

- Est-ce le code se trouve dans le fichier où vous avez le feuille Agents ?
- Est-ce dans le tableau "TblAgents" que vous complétez les données ?
- est-ce que votre bouton command1 est placé sur la feuille ou dans une userform ?

- J'éviterais d'utiliser txt comme variable sachant que txt est aussi une extension de fichier (et ne prenez pas "Texte" non plus)

Pour le reste je regarde mais sans le fichier c'est moins facile

Le 09/08/2023 à 10:51

Merci de ce retour,

Le code est dans le même excel dans un userform nommé addWorker.
Je rajoute des données à la ligne juste après TblAgents de sorte que les formules de certaines cases se complètent seules.
Le CommandButton est dans le userform addWorker.

image

Dans mon fichier pour l'instant j'ai ici 57 Agents.
J'ai du modifier quelques nom de variables dans l'exemple.
Je vais remplacer txt par myText.

Je peux essayer d'extraire uniquement cette feuille et de supprimer les données personnelles pour joindre un fichier.

Le 09/08/2023 à 10:56

re

Ok pour "mytxt"

Je peux essayer d'extraire uniquement cette feuille et de supprimer les données personnelles pour joindre un fichier.

Sachez que vous pouvez anonymiser avec cet utilitaire -> https://www.excel-pratique.com/fr/utilitaires/anonymisation-donnees

Edit : essayez votre code comme ceci

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Integer, lig as integer

Dim nomprenom As String
Dim mytxt As String
Dim Job As String
Dim Agence As String
Dim Nom As String
Dim Prenom As String
Dim D As Double

Nom = TextNom.Value
Prenom = TextPrenom.Value
Agence = ComboBoxAgence.Value
Job = ComboBoxFonction.Value

'MsgBox (Agence)

nomprenom = TextNom.Value & " " & TextPrenom.Value
nomprenom = UCase(nomprenom)

'MsgBox ("Contrôle 1")
'On contrôle les données insérées

If nomprenom = vbNullString Then
    MsgBox ("Veuillez rentrer un nom/prénom")
    Exit Sub
End If
If Job = vbNullString Then
    MsgBox ("Veuillez rentrer une fonction")
    Exit Sub
End If
If Agence = vbNullString Then
    MsgBox ("Veuillez rentrer un employeur")
    Exit Sub
End If
If Not IsNumeric(TextBoxD.Value) Then
    MsgBox ("La valeur D n'est pas correcte")
    Exit Sub
End If

D = CDbl(TextBoxD.Value)

Set ws = ThisWorkbook.Sheets("Agents")

'Checker si l'agent est déja là
On Error Resume Next
i = WorksheetFunction.Match(nomprenon, ws.ListObjects("TblAgents").ListColumns(3),0)
If i > 0 Then MsgBox "L'agent est déjà suivi !": Exit Sub
On Error GoTo 0

mytxt = "Ajouter le suivi du collaborateur ?"
mytxt = mytxt & Chr(13) & Chr(10) & Chr(13) & Chr(10)
mytxt = mytxt & "Agent : " & nomprenom
mytxt = mytxt & Chr(13) & Chr(10)
mytxt = mytxt & "Fonction : " & Job
mytxt = mytxt & Chr(13) & Chr(10)
mytxt = mytxt & "Agence : " & Agence
mytxt = mytxt & Chr(13) & Chr(10)
mytxt = mytxt & "D: " & D

If MsgBox(mytxt, vbQuestion + vbYesNo + vbDefaultButton2, "Alerte") = vbYes Then
'Si l'utilisateur accepte
    With ws
        .Unprotect
        With .ListObjects("TblAgents")
            If .ListRows.Count = 0 Then
                .ListRows.Add: i = 1
            Else: .ListRows.Add: i = .ListRows.Count 'insérer à la dernière ligne
            End If
            .DataBodyRange(i, 1) = Nom
            .DataBodyRange(i, 2) = Prenom
            .DataBodyRange(i, 5).Value = Agence
            .DataBodyRange(i, 6).Value = Job
            .DataBodyRange(i, 7).Value = D
            Union(.DataBodyRange(i, 8), .DataBodyRange(i, 13)) = 0 'Par défaut autres cases sont numériques et sont vides (0)
        End With
    End With

    'On tri les données ensuite
    On Error Resume Next
    With ws.ListObjects("TblAgents")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("TblAgents[[#All],[Nom Prénom]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    On Error GoTo 0

    'Fin du tri
    ws.Protect
    MenuWorker.Show'On revient au menu précédent
    End If
End Sub

NB : vous auriez pu mettre votre code de tri dans une macro séparée.

Si ok pensez à

Le 09/08/2023 à 11:51

Encore merci,

Dans ce code j'ai une erreur de compilation :

image

Apparemment, lorsque je place mon curseur dans la formule, l'argument 2 n'est pas en gras, signe qu'il ne serait pas "bien formalisé" ?

image

Contrairement au premier avant la virgule,

image

J'ai corrigé comme suit après avoir regardé la documentation

i = WorksheetFunction.Match(nomprenom, ws.ListObjects("TblAgents").ListColumns(3))

Mais le problème persiste.
En mode pas à pas, c'est cet endroit qui fait fermer le fichier :

Else: .ListRows.Add: i = .ListRows.Count 'insérer à la dernière ligne

D'ailleurs le problème n'est pas toujours là et j'ai remarqué que même ajouter des données à la main à la dernière ligne faisait planter le fichier parfois.

J'ai l'impression que le tableau ne peut pas s'agrandir mais sans savoir pourquoi/dans quels cas.

EDIT : Je n'ai pourtant aucune macro qui tourne sur les évènement de la feuille ni du classeur.

Le 09/08/2023 à 11:58

J'ai corrigé comme suit après avoir regardé la documentation
i = WorksheetFunction.Match(nomprenom, ws.ListObjects("TblAgents").ListColumns(3))

Hum... oui désolé. j'ai fait cela sans vérifier et j'étais parti avec la fonction FIND puis je n'ai pas corrigé.
J'ai amendé le code dans mon post précédent

Mais le problème persiste.
En mode pas à pas, c'est cet endroit qui fait fermer le fichier :

Il faudrait que je vois votre fichier pour analyser.
Soit vous l'anonymisez ou alors vous pouvez me le joindre en MP

Vous avez probablement un souci dans votre tableau structuré

Edit : dans votre code faites un peu le test en ajoutant ceci juste en dessous du IF MSGBOX..... then

Msgbox ws.ListObjects("TblAgents").listrows.count
Rechercher des sujets similaires à "methode value objet range echoue"