XL 2016 Erreur définie par l'application ou l'objet

pts74 · 16 Juin 2022

Bonjour
J'ai un petite base de données en Excel dans laquelle j'ai une liste de personnes identifiées chacune par un code.
J'ai fait un UserForm pour la modification des information de cette liste de personnes. La liste des codes est récupérée dans un comboBox du UserForm. Une fois le code choisi, un bouton permet de filtrer la table et de récupérer la personne concernée, les informations initialement saisies sont renseignées dans les autres TexteBox du Userform.
Le problème c'est que le code marche seulement quand la feuille qui contient la liste est active, sinon je reçois l’erreur "Erreur définie par l'application ou l'objet"

Voici mon code (code du bouton) :

VB:

Private Sub CommandButton_OK_Click()
    critereCode = ComboBox_Code.Value
    If critereCode <> "" Then
        ThisWorkbook.Worksheets("listepersonnes").Range("A1").AutoFilter Field:=1, Criteria1:=critereCode
    End If
    
    no_ligne = ThisWorkbook.Worksheets("listepersonnes").Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
    
    TextBox_CodeP = Sheets("listepersonnes").Cells(no_ligne, 1).Value
    TextBox_Nom = Sheets("listepersonnes").Cells(no_ligne, 2).Value
    TextBox_Prenom = Sheets("listepersonnes").Cells(no_ligne, 3).Value
    TextBox_Age = Sheets("listepersonnes").Cells(no_ligne, 4).Value
    TextBox_Fonction = Sheets("listepersonnes").Cells(no_ligne, 5).Value
    TextBox_Sexe = Sheets("listepersonnes").Cells(no_ligne, 6).Value

End Sub

Puis-je avoir de l'aide pour corriger l'erreur?

sylvanu · 16 Juin 2022

Bonjour Pts74, et bienvenu sur XLD,
Un petit fichier test représentatif aurait éviter une réponse "au pif".
Alors essayez :

VB:

Private Sub CommandButton_OK_Click()
    FeuilleCourante = ActiveSheet.Name  ' Mémorise la feuille courante
    Application.ScreenUpdating = False
    With Worksheets("listepersonnes")  ' Le With évite de répéter sans cesse le nom de la feuille,
         .Select  ' Sélectionne la feuille "listepersonnes"
        critereCode = ComboBox_Code.Value
        If critereCode <> "" Then
            .Range("A1").AutoFilter Field:=1, Criteria1:=critereCode
        End If
        no_ligne = .Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
        TextBox_CodeP = .Cells(no_ligne, 1).Value
        TextBox_Nom = .Cells(no_ligne, 2).Value
        TextBox_Prenom = .Cells(no_ligne, 3).Value
        TextBox_Age = .Cells(no_ligne, 4).Value
        TextBox_Fonction = .Cells(no_ligne, 5).Value
        TextBox_Sexe = .Cells(no_ligne, 6).Value
    End With
    Sheets(FeuilleCourante).Select      ' Retourne sur la feuille initiale
    Application.ScreenUpdating = True
End Sub

On fige l'écran, on sélectionne la feuille, on bosse et on revient sur la feuille initiale.
Bien sur au pif car non testée.
Le With évite de répéter sans cesse le nom de la feuille, ne pas oublier le "." devant chaque cellule appelée pour bien prendre en compte la feuille.
Cells(no_ligne, 1).Value adresse la feuille courante
.Cells(no_ligne, 1).Value adresse la feuille déclarée dans le With.

pts74 · 16 Juin 2022

Bonjour sylvanu
Merci pour la proposition qui marche bien.
Merci

pts74 · 17 Juin 2022

Bonjour !
Désolé de réveiller le sujet!
Le code marche bien seulement quand la feuille "listepersonnes" est masquée il ne fonctionne plus alors que mon souhait c'est que la feuille reste masquée.
Ci-joint, le fichier
Merci

sylvanu · 17 Juin 2022

Bonjour,
Comme dit ci dessus :

sylvanu à dit:
Un petit fichier test représentatif aurait éviter une réponse "au pif".

On ne pouvez pas imaginer qu'une feuille était masquée.
Le plus simple est de la démasquer, de travailler puis de la re-masquer.

pts74 · 17 Juin 2022

sylvanu à dit:
Bonjour,
Comme dit ci dessus :

On ne pouvez pas imaginer qu'une feuille était masquée.
Le plus simple est de la démasquer, de travailler puis de la re-masquer.

Désolé. Mais j'ai joint le fichier à mon dernier post

sylvanu · 17 Juin 2022

Re,
Je voulez juste dire qu'il était absent lors de votre premier post.
Et j'ai horreur de reworker, alors tentez :

VB:

Sub lancer_fmaje()
    Application.ScreenUpdating = False                      ' Ecran figé
    Sheets("listepersonnes").Visible = xlSheetVisible       ' listepersonnes visible
    Form_MAJ_Personne.Show                                  ' lancer useform
    Sheets("listepersonnes").Visible = xlSheetVeryHidden    ' masquer listepersonnes
    Application.ScreenUpdating = True                       ' Liberer écran
End Sub

pts74 · 17 Juin 2022

sylvanu à dit:
Et j'ai horreur de reworker, alors tentez :

J'ai pas bien compris cette phrase.
Mais je teste le code et je vous reviens! Merci

Hasco · 17 Juin 2022

Bonjour,

le code de @sylvanu (post #2) peut fonctionner sur feuille masquée.
Il suffit de supprimer les lignes de selection de feuille et de mettre un point devant le Cell de :

Cells(Rows.Count, "A")

Pour avoir

.Cells(Rows.Count, "A")

Sinon une proposition sans filtre mais en utilisant la fonction Equiv (MATCH) pour retrouver la personne.

VB:

Private Sub CommandButton_OK_Click()
    With Worksheets("listepersonnes")  ' Le With évite de répéter sans cesse le nom de la feuille,
        '  .Select  ' Sélectionne la feuille "listepersonnes"
        criterecode = ComboBox_Code.Value
        ' Utilisation de la fonction Equiv pour retrouver la ligne
        no_ligne = Application.Match(criterecode, .Range("A1", .Cells(Rows.Count, "A").End(xlUp)), 0)
        If Not IsError(no_ligne) Then
            TextBox_CodeP = .Cells(no_ligne, 1).Value
            TextBox_Nom = .Cells(no_ligne, 2).Value
            TextBox_Prenom = .Cells(no_ligne, 3).Value
            TextBox_Age = .Cells(no_ligne, 4).Value
            TextBox_Fonction = .Cells(no_ligne, 5).Value
            TextBox_Sexe = .Cells(no_ligne, 6).Value
        Else
            MsgBox "Code de personne non trouvé : " & criterecode, vbExclamation, "fiche personne"
        End If
    End With
End Sub

Cordialement

XL 2016 Erreur définie par l'application ou l'objet

pts74

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

pts74

XLDnaute Nouveau

pts74

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

pts74

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

pts74

XLDnaute Nouveau

Hasco

XLDnaute Barbatruc

Pièces jointes

Discussions similaires