XL 2016 message d'erreur

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion phil107
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

phil107

XLDnaute Nouveau
bonjour, j'ai ce message d'erreur qui apparait quelques fois

erreur d'exécution avec tout une suite de chiffre puis la méthode defaut de l'objet range a échoué

dans mon fichier lorsque je rentre un nouveau vin j'ai ce message d'erreur . merci d'avance pour l'aide que vous pourrez m"apporter

cordialement
 

Pièces jointes

Trier par date Trier par votes
Bonsoir à tous

J'ai apporté quelques modifications à votre code, j'ai trouvé plusieurs erreurs



VB: 
Private Sub CommandButton1_Click()

Dim MyLastRow As Integer
Dim UserAnswer As VbMsgBoxResult
Dim tbl As ListObject
Dim ws As Worksheet
Dim sortcolumn As Range

UserAnswer = MsgBox("• Confirmez-vous cet ajout?", vbYesNo + vbQuestion, "Confirmation!")
    If CStr(UserAnswer) = CStr(False) Then Exit Sub
    If UserAnswer = vbCancel Then Exit Sub
    If UserAnswer = vbNo Then Exit Sub
    
Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
  
With ws
    .Activate
    MyLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' ajout des données concernant le vin   Zone Jaune du tableau colonne 1 à 7
    .Cells(MyLastRow, 1) = CBB2.Value & " " & CBB3.Value & " " & CBB4.Value & " " & CBB6 ' Appellation + classement + climat + année
    .Cells(MyLastRow, 2) = CBB1.Value                                                    ' Région
    .Cells(MyLastRow, 3) = CBB5.Value                                                    ' Couleur
    .Cells(MyLastRow, 4) = CBB7.Value                                                    ' Nbre achat
    .Cells(MyLastRow, 5) = CBB11.Value                                                   ' Contenance
    .Cells(MyLastRow, 6) = CBB6.Value                                                    ' Millesime
    .Cells(MyLastRow, 7) = CBB9.Value & "." & CBB10.Value                   ' Rangement
    .Cells(MyLastRow, 18) = CBB8.Value                                                   ' Région
'  ajout des données concernant le domaine    Zone rose  du tableau colonne 8 à 12
    .Cells(MyLastRow, 8) = TxtDomaine.Value                                              ' Nom du domaine
    .Cells(MyLastRow, 9) = TxtAdresse & " " & TxtCp.Value & " " & TxtVille.Value         ' adresse
    .Cells(MyLastRow, 10) = TxtTel.Value                                                 'Telephone
    .Cells(MyLastRow, 11) = TxtMail.Value                                                ' Mail
    .Cells(MyLastRow, 12) = TxtInternet.Value                                            ' internet

' ajout des donnees concernant les caracteristiques du vin
    .Cells(MyLastRow, 13) = TxtInformation.Value
    .Cells(MyLastRow, 14) = TxtQuemangerAvec.Value
    .Cells(MyLastRow, 15) = TxtCaracteristique.Value
    .Cells(MyLastRow, 16) = TxtServiceVin.Value
    .Cells(MyLastRow, 17) = TxtConservation.Value
End With

'Classement des vins par annee
Set tbl = ws.ListObjects("Tableau2")
Set sortcolumn = Range("Tableau2[Millesime]")

With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
   .Header = xlYes
   .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
   .Apply
End With

If Not sortcolumn Is Nothing Then Set sortcolumn = Nothing
If Not tbl Is Nothing Then Set tbl = Nothing
If Not ws Is Nothing Then Set ws = Nothing

End Sub

J'espère aider
 
Vote positif 0 Vote négatif
Bonjour à tous

votre feuille de calcul contenait des erreurs, je ne sais pas comment spécifier, mais j'ai dû supprimer toute mise en forme car il n'était pas possible d'insérer une nouvelle ligne dans le tableau

mon conseil est avant de copier les codes suivants que je vais mettre, copiez les données de la feuille de calcul " liste_vin " dans une nouvelle feuille de calcul, mais collez simplement les valeurs, sans conditions ni format

supprimer l'ancienne feuille de calcul et renommer la nouvelle feuille de calcul en "liste_vin"

sélectionnez les données pour créer la table et renommez la table avec "Tableau2"

ajouter un module standard, et copiez les codes suivants et collez-les


VB: 
Public Function TableExists(tableName As String, ws As Worksheet) As Boolean ' DÉTERMINER SI LE NOM DE LA TABLE EXISTE
    On Error GoTo TableExists_Error
    If ws.ListObjects(tableName).Name = vbNullString Then
    End If
   
    TableExists = True
   
    On Error GoTo 0
    Exit Function
   
TableExists_Error:
        TableExists = False
End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean ' Déterminer si un nom de feuille de calcul existe dans ce classeur
    On Error Resume Next
    WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

remplacez le code que vous avez dans CommandButton1_Click par ce qui suit

VB: 
Private Sub CommandButton1_Click()
    If Not WorksheetExists("liste_vin") Then ' Déterminer si un nom de feuille de calcul existe dans ce classeur (MACRO)
        MsgBox "Erreur critique:" & vbCrLf & vbCrLf & "• Base de données introuvable!", vbCritical, "Information!"
        Exit Sub
    End If
   
    Dim ws As Worksheet
    Dim tableName As String
    Dim xAdd(17)
    Dim UserAnswer As VbMsgBoxResult
    Dim tbl As ListObject
    Dim sortcolumn As Range
   
    UserAnswer = MsgBox("• Confirmez-vous cet ajout?", vbYesNo + vbQuestion, "Confirmation!")
        If CStr(UserAnswer) = CStr(False) Then Exit Sub
        If UserAnswer = vbCancel Then Exit Sub
        If UserAnswer = vbNo Then Exit Sub
   
    tableName = "Tableau2"
    Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
   
    If Not TableExists(tableName, ws) Then '  table exist (MACRO)
        MsgBox "Accès refusé: " & vbCrLf & vbCrLf & " • Base de données non trouvée, vérifiez si elle a déjà été créée! ", vbCritical, "Information!"
        If Not ws Is Nothing Then Set ws = Nothing
        Exit Sub
    End If
   
    ' ajout des données concernant le vin   Zone Jaune du tableau colonne 1 à 7
    xAdd(0) = Me.CBB2.Value & " " & Me.CBB3.Value & " " & Me.CBB4.Value & " " & Me.CBB6.Value   ' Appellation + classement + climat + année
    xAdd(1) = Me.CBB1.Value                                                                     ' Région
    xAdd(2) = Me.CBB5.Value                                                                     ' Couleur
    xAdd(3) = Me.CBB7.Value                                                                     ' Nbre achat
    xAdd(4) = Me.CBB11.Value                                                                    ' Contenance
    xAdd(5) = CBB6.Value                                                                        ' Millesime
    xAdd(6) = Me.CBB9.Value & "." & Me.CBB10.Value                                              ' Rangement
    xAdd(17) = Me.CBB8.Value                                                                    ' Région
    '  ajout des données concernant le domaine    Zone rose  du tableau colonne 8 à 12
    xAdd(7) = Me.TxtDomaine.Value                                                               ' Nom du domaine
    xAdd(8) = Me.TxtAdresse.Value & " " & Me.TxtCp.Value & " " & Me.TxtVille.Value              ' adresse
    xAdd(9) = Me.TxtTel.Value                                                                   ' Telephone
    xAdd(10) = Me.TxtMail.Value                                                                 ' Mail
    xAdd(11) = Me.TxtInternet.Value                                                             ' internet
    ' ajout des donnees concernant les caracteristiques du vin
    xAdd(12) = Me.TxtInformation.Value
    xAdd(13) = Me.TxtQuemangerAvec.Value
    xAdd(14) = Me.TxtCaracteristique.Value
    xAdd(15) = Me.TxtServiceVin.Value
    xAdd(16) = Me.TxtConservation.Value
   
    AddRecordTableRow tableName, xAdd
   
    'Classement des vins par annee
    With ws.Range("Tableau2")
     LastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
    End With
   
    Set tbl = ws.ListObjects("Tableau2")
    Set sortcolumn = ws.Range("F8:F" & LastRow)
   
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With
   
    If Not sortcolumn Is Nothing Then Set sortcolumn = Nothing
    If Not tbl Is Nothing Then Set tbl = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
End Sub


et collez le code suivant juste après l'événement CommandButton1_Click

VB: 
Private Sub AddRecordTableRow(XtableName As String, values() As Variant)
    Dim ws As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim LastRow As Integer, lastcol As Integer
   
    Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
   
    With ws
        .Activate
        Set table = .ListObjects.Item(XtableName)
       
        With .Range("Tableau2")
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            Debug.Print LastRow
            lastcol = .Columns.Count
            Debug.Print lastcol
        End With
   
        If table.ListRows.Count > 0 Then
            For col = 1 To lastcol
                If Trim(CStr(.Cells(LastRow, col).Value)) <> "" Then
                    table.ListRows.Add AlwaysInsert:=True
                    Exit For
                End If
            Next col
        Else
            table.ListRows.Add AlwaysInsert:=True
        End If
   
        LastRow = LastRow + 1
       
        For col = 1 To lastcol
            If col <= UBound(values) + 1 Then .Cells(LastRow, col) = values(col - 1)
        Next col
   
    End With
   
    MsgBox "• Nouveau record de vin ajouté!", vbInformation, "Information!"
   
    If Not table Is Nothing Then Set table = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
End Sub

J'ai fait plusieurs tests, et tout fonctionne parfaitement


J'espère aider
 
Vote positif 0 Vote négatif
Bonsoir à tous


vous avez une erreur, elle est marquée en rouge, vous aviez:
tableName = "Tableau2"
au lieu d'avoir
tableName = "Tableau22"


Private Sub CommandButton1_Click()
If Not WorksheetExists("liste_vin") Then ' Déterminer si un nom de feuille de calcul existe dans ce classeur (MACRO)
MsgBox "Erreur critique:" & vbCrLf & vbCrLf & "• Base de données introuvable!", vbCritical, "Information!"
Exit Sub
End If

Dim ws As Worksheet
Dim tableName As String
Dim xAdd(17)
Dim UserAnswer As VbMsgBoxResult
Dim tbl As ListObject
Dim sortcolumn As Range

UserAnswer = MsgBox("• Confirmez-vous cet ajout?", vbYesNo + vbQuestion, "Confirmation!")
If CStr(UserAnswer) = CStr(False) Then Exit Sub
If UserAnswer = vbCancel Then Exit Sub
If UserAnswer = vbNo Then Exit Sub

tableName = "Tableau22"
Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
...

Je viens de corriger cette erreur et cela fonctionne

J'espère aider
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

AIXELS
  • Question Question
Autres Copie de données (message d'erreur)
Réponses
3
Affichages
281
AIXELS
AIXELS
N
  • Question Question
Microsoft 365 Alimenter une Combo Active X inséré dans une feuille de calcul
Réponses
3
Affichages
204
NONO14
N
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
561
robpellan52
R
K
  • Question Question
Microsoft 365 Défiltrer une colonne avec VBA
Réponses
2
Affichages
465
Phil69970
Phil69970
L
  • Question Question
Microsoft 365 ActiveWorkbook.SaveAs Filename:= _
Réponses
7
Affichages
660
lesoldat9
L
T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
804
Thomi
T
O
  • Question Question
XL 2019 erreur de valeur sur formule
2
Réponses
18
Affichages
857
olivier1984
O
C
  • Résolu(e)
XL 2016 erreur 1004 _ la méthode range de l'objet global a échoué
Réponses
5
Affichages
711
ced91300
C
O
  • Question Question
XL 2013 Message d'erreur lors d'une exécution d'1 Macro/VBA
Réponses
1
Affichages
417
fanch55
fanch55
F
  • Question Question
XL 2021 création d'un fichier "xlsm"
Réponses
5
Affichages
345
flag06
F
O
  • Résolu(e)
XL 2013 Erreur : La méthode 'range' de l''objet'_Global a échoué
Réponses
5
Affichages
640
kiki29
kiki29
A
  • Résolu(e)
XL 2016 Regroupement dates sur TCD
Réponses
3
Affichages
462
Aldonanou
A
C
  • Question Question
XL 2016 accès feuilles masquées par bouton
2
Réponses
26
Affichages
464
vgendron
vgendron
R
  • Question Question
XL 2016 userform / remplir combobox suivant une autre combobox
Réponses
3
Affichages
562
ChTi160
ChTi160
sebastianbl
  • Résolu(e)
XL 2021 Aide macro / nettoyage fichier
2 3
Réponses
42
Affichages
870
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2016 On Error, relancer le sub une seule fois
Réponses
7
Affichages
560
mxdktm
M
M
  • Question Question
XL 2010 (Génération d'invitations) Erreur 424 ???
2
Réponses
17
Affichages
1 K
patricktoulon
patricktoulon
D
  • Question Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
696
crocrocro
C
R
  • Question Question
XL 2021 Erreur d'exécution '-2147417848 (80010108). La méthode '-Default' de l'objet 'Range' a échoué après quelques saisies d'enregistrement
2
Réponses
23
Affichages
2 K
Rv_38
R
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
439
loreak
L
Retour