Erreur d'exécution 1004 : Erreur définie par l'application ou par l'objet

Le 11/07/2024 à 16:13

Bonjour,

Je cherche à modifier les propriétés d'une ligne (couleur, bordures) dans ma base de données lorsque j'enregistre une facture à partir de mon formulaire.

Néanmoins, je suis obligé de rajouter les lignes de codes en rouge ci-dessous pour que la macro fonctionne. Sauriez-vous comment modifier ma ligne sans avoir à activer la feuille en question à chaque fois ?

En vous remerciant par avance.

Sub EnregistrementFacture()

(...)

' Mise en page de la cellule nouvellement remplie (couleurs, bordures, etc)

Dim ColorColumn1 As Long, ColorColumn2 As Long

ColorRow = ligne_insertion

ColorColumn1 = Sheets("Factures").Range("Référent").Column

ColorColumn2 = Sheets("Factures").Range("Commentaire").Column

If Sheets("Factures").Cells(ligne_insertion - 1, Range("Référent").Column).Interior.Color = RGB(155, 194, 230) Then

Sheets("Factures").Select

Sheets("Factures").Range(Cells(ligne_insertion, ColorColumn1), Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(32, 128, 255)

Sheets("Factures").Range(Cells(ligne_insertion, ColorColumn1), Cells(ligne_insertion, ColorColumn2)).Borders.Value = 1

Sheets("Formulaire factures").Select

Else

Sheets("Factures").Select

Sheets("Factures").Range(Cells(ligne_insertion, ColorColumn1), Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(155, 194, 230)

Sheets("Factures").Range(Cells(ligne_insertion, ColorColumn1), Cells(ligne_insertion, ColorColumn2)).Borders.Value = 1

Sheets("Formulaire factures").Select

End If

MsgBox ("La facture a bien été enregistré.")

End If

End Sub

28formulaire.xlsm (67.94 Ko)
Le 11/07/2024 à 18:08

Bonjour jojowww,

Mon ami GPT, Chat de son pénom, propose :

Sub EnregistrementFacture()
    Const FORM_SHEET As String = "Formulaire factures"
    Const FACT_SHEET As String = "Factures"
    Dim wsForm As Worksheet
    Dim wsFact As Worksheet
    Dim ligne_insertion As Long
    Dim ColorColumn1 As Long, ColorColumn2 As Long

    ' Set worksheet references
    Set wsForm = Sheets(FORM_SHEET)
    Set wsFact = Sheets(FACT_SHEET)

    ' Check if all required data is filled
    If wsForm.Range("valida").Value = False Then
        MsgBox "Erreur : Vous n'avez pas rempli toutes les données obligatoires (Données avec un '*')"
        Exit Sub
    End If

    ' Determine the last empty row in the table
    ligne_insertion = wsFact.Range("A1").End(xlDown).Row + 1

    ' Handle case when the table is empty
    If ligne_insertion > 5000 Then
        ligne_insertion = 2
    End If

    ' Record data
    wsFact.Cells(ligne_insertion, wsFact.Range("Référent").Column).Value = wsForm.Range("RéférentFormulaire").Value
    wsFact.Cells(ligne_insertion, wsFact.Range("N°Marché").Column).Value = wsForm.Range("N°MarchéFormulaire").Value
    wsFact.Cells(ligne_insertion, wsFact.Range("MontantHT").Column).Value = wsForm.Range("MontantHTFormulaire").Value
    wsFact.Cells(ligne_insertion, wsFact.Range("Tiers").Column).Value = wsForm.Range("TiersFormulaire").Value
    wsFact.Cells(ligne_insertion, wsFact.Range("DateRemiseFacture").Column).Value = wsForm.Range("DateRemiseFactureFormulaire").Value
    wsFact.Cells(ligne_insertion, wsFact.Range("Commentaire").Column).Value = wsForm.Range("CommentaireFormulaire").Value

    ' Format the newly filled cells
    ColorColumn1 = wsFact.Range("Référent").Column
    ColorColumn2 = wsFact.Range("Commentaire").Column

    If wsFact.Cells(ligne_insertion - 1, ColorColumn1).Interior.Color = RGB(155, 194, 230) Then
        wsFact.Range(wsFact.Cells(ligne_insertion, ColorColumn1), wsFact.Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(32, 128, 255)
    Else
        wsFact.Range(wsFact.Cells(ligne_insertion, ColorColumn1), wsFact.Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(155, 194, 230)
    End If

    wsFact.Range(wsFact.Cells(ligne_insertion, ColorColumn1), wsFact.Cells(ligne_insertion, ColorColumn2)).Borders.Value = 1

    MsgBox "La facture a bien été enregistrée."
End Sub

Bizz

Le 11/07/2024 à 19:14

Bonjour,

Lorsque vous postez un code pensez à le coller dans la fenêtre en cliquant au préalable sur l'icone </> dans la barre de menu. C'est plus lisible pour celui qui vous répond

Vous y étiez presque...
En analysant votre code (sans chatgpt...) et en modifiant quelque peu.
Remplacez le par celui-ci dessous et il vous suffit de cliquez sur le bouton Enregistrement (nul besoin d'être sur la feuille facture)

Sub EnregistrementFacture()
Dim ligne_insertion As Integer

If Sheets("Formulaire factures").Range("valida") = True Then 'Vérification que toutes les données nécessaires soient renseignées
    With Sheets("Factures")
        ' Détermine la dernière ligne vide du tableau
        ligne_insertion = .Range("A" & Rows.Count).End(xlUp).Row + 1

         ' Enregistrement Référent
        .Cells(ligne_insertion, Range("Référent").Column) = Sheets("Formulaire factures").Range("RéférentFormulaire")

        ' Enregistrement N° Marché
        .Cells(ligne_insertion, Range("N°Marché").Column) = Sheets("Formulaire factures").Range("N°MarchéFormulaire")

        ' Enregistrement Montant HT
        .Cells(ligne_insertion, Range("MontantHT").Column) = Sheets("Formulaire factures").Range("MontantHTFormulaire")

         ' Enregistrement Tiers
        .Cells(ligne_insertion, Range("Tiers").Column) = Sheets("Formulaire factures").Range("TiersFormulaire")

        'Enregistrement Date de remise de la facture
        .Cells(ligne_insertion, Range("DateRemiseFacture").Column) = Sheets("Formulaire factures").Range("DateRemiseFactureFormulaire")

        ' Enregistrement Commentaire
        .Cells(ligne_insertion, Range("Commentaire").Column) = Sheets("Formulaire factures").Range("CommentaireFormulaire")

        If .Cells(ligne_insertion, .Range("Référent").Column).Interior.Color = RGB(155, 194, 230) Then
            .Range(.Cells(ligne_insertion, .Range("Référent").Column), .Cells(ligne_insertion, .Range("Commentaire").Column)).Interior.Color = RGB(32, 128, 255)
            .Range(.Cells(ligne_insertion, .Range("Référent").Column), .Cells(ligne_insertion, .Range("Commentaire").Column)).Borders.Value = 1
        Else
            .Range(.Cells(ligne_insertion, .Range("Référent").Column), .Cells(ligne_insertion, .Range("Commentaire").Column)).Interior.Color = RGB(155, 194, 230)
            .Range(.Cells(ligne_insertion, .Range("Référent").Column), .Cells(ligne_insertion, .Range("Commentaire").Column)).Borders.Value = 1

        End If

        MsgBox "La facture a bien été enregistrée.", vbInformation, "Enregistrement Facture"
    End With

Else:
        'Si toutes les données nécessaires sont renseignées, alors :
        MsgBox "Erreur : Vous n'avez pas rempli toutes les données obligatoires (Données avec un '*')", vbCritical, "Donnees manquantes"
    End If
End Sub

si ok, pensez à

Cordialement

Le 12/07/2024 à 09:37

Super ça fonctionne, merci !

Je ferai attention à bien coller mon code comme tel la prochaine fois ;)

Néanmoins, je vois bien que votre code est mieux pensé, mais je ne vois pas d'où viens l'erreur dans le mien...

Si vous avez le temps, je prendrais volontiers des explications !

Cordialement

Le 12/07/2024 à 13:25

Bonjour

Si vous avez le temps, je prendrais volontiers des explications !

Mais bien sûr, voici une explication
Lorsque vous exécutez le code vous vous trouvez sur la feuille saisie et vous cliquez sur votre bouton Enregistrer

Dans votre ligne ci-dessous, le code prend en compte cells(ligne_insertion comme étant la cellule sur votre feuille enregistrement et pas la feuille facture

Sheets("Factures").Range(Cells(ligne_insertion, ColorColumn1), Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(32, 128, 255)

Du coup vous auriez dû l'écrire comme ceci

Sheets("Factures").Range(Sheets("Factures").Cells(ligne_insertion, ColorColumn1), Sheets("Factures").Cells(ligne_insertion, ColorColumn2)).Interior.Color = RGB(32, 128, 255)

Raison pour laquelle vous verrez que dans le code pour la même ligne :
1. Avec WITH j'ai mis en évidence sheets("Factures") pour ne pas répéter chaque fois dans une ligne
2. dû au WITH j'ai ajouté des points devant RANGE et devant CELLS dans le code que je vous ai donné

Vous comprenez ?

Crdlt

Le 15/07/2024 à 09:22

Maintenant que vous le dites, ça parait logique..

Merci !

Rechercher des sujets similaires à "erreur execution 1004 definie application objet"