XL 2019 Macro - erreur d'exécution

  • Initiateur de la discussion Initiateur de la discussion jes030390
  • 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 !

jes030390

XLDnaute Nouveau
Bonjour,

J'ai un fichier Excel avec une macro qui bug : "Erreur d'exécution 1004" Quelqu'un aurait une solution?

De plus, j'aimerais protéger la feuille par un mot de passe pour avoir accès uniquement à certaines cellules "Sélectionner les cellules déverouillées" mais lorsque je protège la feuille le bouton de la macro passe en mode protéger et bug.

Je ne trouve pas la solution.

Merci d'avance pour votre aide.
 

Pièces jointes

Hello,

Remplace
VB:
Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

par
Code:
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Comme ça tu colles à la suite de la dernière ligne remplie
 
Hello,

Remplace
VB:
Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

par
Code:
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Comme ça tu colles à la suite de la dernière ligne remplie

Merci pour votre retour don_pets malheureusement lorsque je fait le test et entre des infos dans le formulaire elles ne se retrouvent pas dans la BDD :/
 
try this

VB:
With Sheets("Formulaire")
    .Range("a2:BI2").Copy
End With

With Sheets("BDD")
    .Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

c'est parce qu'il faut coller les valeurs et non les formules, my bad
 
try this

VB:
With Sheets("Formulaire")
    .Range("a2:BI2").Copy
End With

With Sheets("BDD")
    .Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

c'est parce qu'il faut coller les valeurs et non les formules, my bad

Merci beaucoup don_pets c'est parfait ! 🙂

J'aimerais également protéger la feuille par un mot de passe pour avoir accès uniquement à certaines cellules "Sélectionner les cellules déverouillées" mais lorsque je protège la feuille le bouton de la macro bug.
 

Pièces jointes

bonjour
perso l'enregistreur de macro c'est bien mais le code obtenu est une base
il est à netoyer et/ou optimiser
donc
j'ai protégé ton formulaire (mot de passe "toto")
j'ai donc verrouillé toute les cellules non concernée(les cellule couleur saumon) et déverouillé les autres ça t'évitera de pourrir ton formulaire en écrivant dans des cellules pour rien

puré de puré de non de dieu !!!
tu a la ligne2 qui contient tout le formulaire
c'est pas compliqué de prendre cette ligne , en faire une variable array et la transcrire dans BDD
et pas besoins de select ou autres activate
conclusion :
le code du bouton
VB:
Sub ajouter_employe()
    Dim tbl
    With Sheets("Formulaire")
        tbl = Application.Index(.Range("A2:BI2").Value, 1, 0)    'recupere dans tbl ta ligne2 caché dans formulaire

        Sheets("BDD").Range("A100000").End(xlUp).Offset(1, 0).Resize(1, UBound(tbl)).Value = tbl    'on transcrit dans BDD
        MsgBox "les données de " & .[B5] & " " & .[D5] & " " & .[F5] & " ont été ajoutées  à la base de données"
        'et on clear le formulaire
        Union(.Range( _
              "B43,D43,F43,F40,B46,D46,B49,D49,B52,B55,D55,F55,B60,D60,F60,B63,D63,F63,B66,D66,F66,B69,D69,F69,B73:F77,B82,D82,F82,B86,D86,F86,B5" _
              ), .Range( _
                 "D5,F5,B8,D8,F8,B11,D11,F11,B14,D14,B17,D17,F17,B20,D20,F20,B23,D23,B26,D26,B29,D29,B34,D34,F34,B37,D37,F40,B40,D40,F40" _
                 )).ClearContents
    End With
    Sheets("BDD").Activate
End Sub
voila terminé
j'active le BDD a la fin pour que tu puisse voir la newline added mais c'est pas vraiment nécessaire
terminé 😉
ps : je pars chez l'ophtalmo avec ton code j'ai attrapé une pourritecodite aigue 😀 😀 😱 😛 😳😉
 

Pièces jointes

bonjour
perso l'enregistreur de macro c'est bien mais le code obtenu est une base
il est à netoyer et/ou optimiser
donc
j'ai protégé ton formulaire (mot de passe "toto")
j'ai donc verrouillé toute les cellules non concernée(les cellule couleur saumon) et déverouillé les autres ça t'évitera de pourrir ton formulaire en écrivant dans des cellules pour rien

puré de puré de non de dieu !!!
tu a la ligne2 qui contient tout le formulaire
c'est pas compliqué de prendre cette ligne , en faire une variable array et la transcrire dans BDD
et pas besoins de select ou autres activate
conclusion :
le code du bouton
VB:
Sub ajouter_employe()
    Dim tbl
    With Sheets("Formulaire")
        tbl = Application.Index(.Range("A2:BI2").Value, 1, 0)    'recupere dans tbl ta ligne2 caché dans formulaire

        Sheets("BDD").Range("A100000").End(xlUp).Offset(1, 0).Resize(1, UBound(tbl)).Value = tbl    'on transcrit dans BDD
        MsgBox "les données de " & .[B5] & " " & .[D5] & " " & .[F5] & " ont été ajoutées  à la base de données"
        'et on clear le formulaire
        Union(.Range( _
              "B43,D43,F43,F40,B46,D46,B49,D49,B52,B55,D55,F55,B60,D60,F60,B63,D63,F63,B66,D66,F66,B69,D69,F69,B73:F77,B82,D82,F82,B86,D86,F86,B5" _
              ), .Range( _
                 "D5,F5,B8,D8,F8,B11,D11,F11,B14,D14,B17,D17,F17,B20,D20,F20,B23,D23,B26,D26,B29,D29,B34,D34,F34,B37,D37,F40,B40,D40,F40" _
                 )).ClearContents
    End With
    Sheets("BDD").Activate
End Sub
voila terminé
j'active le BDD a la fin pour que tu puisse voir la newline added mais c'est pas vraiment nécessaire
terminé 😉

Merci pour votre retour patricktoulon, malheureusement le fichier bug à l'ouverture : Partie supprimée: /xl/vbaProject.bin partie. (Visual Basic for Applications (VBA))

Désolé je suis novice, mes compétences sont vraiment limite limite :/
 
a ben voila autre choses maintenant
je supprime le mot de passe tu le remetra toi meme
je suis sur 2013 y a peu etre un soucis entre ces deux versions
et pour le coup pour t'eviter de souffrir avec l'union verbeuse des cellules je modifie comme suit ce sera peu etre plus compréhensible pour toi
VB:
Sub ajouter_employe()
    Dim tbl
    With Sheets("Formulaire")
        tbl = Application.Index(.Range("A2:BI2").Value, 1, 0)    'recupere dans tbl ta ligne caché dans formulaire

        Sheets("BDD").Range("A100000").End(xlUp).Offset(1, 0).Resize(1, UBound(tbl)).Value = tbl    'on transcrit dans BDD
        MsgBox "les données de " & .[B5] & " " & .[D5] & " " & .[F5] & " ont été ajoutées  à la base de données"
        'et on clear le formulaire toute les cellules dévérouillées
        For Each cel In .[A3:G100].Cells
            If cel.Locked = False Then cel.MergeArea.Cells(1) = ""
        Next
    End With
    Sheets("BDD").Activate' facultatif
End Sub
 

Pièces jointes

a ben voila autre choses maintenant
je supprime le mot de passe tu le remetra toi meme
je suis sur 2013 y a peu etre un soucis entre ces deux versions
et pour le coup pour t'eviter de souffrir avec l'union verbeuse des cellules je modifie comme suit ce sera peu etre plus compréhensible pour toi
VB:
Sub ajouter_employe()
    Dim tbl
    With Sheets("Formulaire")
        tbl = Application.Index(.Range("A2:BI2").Value, 1, 0)    'recupere dans tbl ta ligne caché dans formulaire

        Sheets("BDD").Range("A100000").End(xlUp).Offset(1, 0).Resize(1, UBound(tbl)).Value = tbl    'on transcrit dans BDD
        MsgBox "les données de " & .[B5] & " " & .[D5] & " " & .[F5] & " ont été ajoutées  à la base de données"
        'et on clear le formulaire toute les cellules dévérouillées
        For Each cel In .[A3:G100].Cells
            If cel.Locked = False Then cel.MergeArea.Cells(1) = ""
        Next
    End With
    Sheets("BDD").Activate' facultatif
End Sub

Le fichier bug toujours malheureusement :/ je suis sur mac, version 2019 peut être pour cette raison ?

Désolé pour la #pourritecoditeaigue 😵🙁
 
re
ha ben voila autre chose
avec Mac et excel tu pars avec un sérieux handicap là
lance un appel au Machiste Alors
a tu au moins essayé sur ton propre fichier de changer le code pour le mien
si oui l'erreur est elle toujours la même
si non ben ... fait le 😉
 
re
ha ben voila autre chose
avec Mac et excel tu pars avec un sérieux handicap là
lance un appel au Machiste Alors
a tu au moins essayé sur ton propre fichier de changer le code pour le mien
si oui l'erreur est elle toujours la même
si non ben ... fait le 😉

j'ai copié ton code sur mon fichier d'origine, effectivement celui-ci fonctionne merci beaucoup 🙂

par contre dès que j'essaye de protéger la feuille j'ai ce message d'erreur : Erreur d'exécution 1004 : La cellule ou le graphique que vous essayer de modifier se trouve sur une feuille protégée. Pour apporter une modification...."

Mais si je mets FIN la ligne se copie bien dans la BDD 🙂
 

Pièces jointes

Bonjour à tous,

Voyez le fichier joint et la macro du bouton :
VB:
Sub ajouter_employe()
With Sheets("BDD")
    .Visible = xlSheetVisible 'si la feuille est masquée
    .Unprotect "toto" 'mot de passe à adapter
    With .Range("A" & .Rows.Count).End(xlUp)(2).Resize(, 61) '1ère ligne vide
        .Value = Sheets("Formulaire").[A2:BI2].Value
        .Replace 0, "", xlWhole 'efface les valeurs zéro
        .Replace "1/0/1900", "" 'si calendrier 1900
        .EntireColumn.AutoFit 'ajustement largeurs
        Application.Goto .Cells(1) 'facultatif
    End With
    .Protect "toto" 'mot de passe à adapter
End With
With Sheets("Formulaire")
    .Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
    .EnableSelection = xlUnlockedCells 'cellules déverrouillées seulement
    .Cells.Locked = True
    With Union(.[B5,D5,F5,B8,D8,F11,B14,D14,B17,D17,F17,B20,D20,F20,B23,D23,B26,D26,B29,D29], _
        .[B34,D34,F34,B37,D37,B40,D40,F40,B43,D43,F43,B46,D46,B49,D49,B52,B55,D55,F55], _
        .[B60,D60,F60,B63,D63,F63,B66,D66,F66,B69,D69,F69,B73:F77,B82,D82,F82,B86,D86,F86])
        .Locked = False 'les cellules sont déverrouillées
        .ClearContents
    End With
End With
End Sub
A priori fonctionne sur toute version.

A+
 

Pièces jointes

- 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

Réponses
3
Affichages
188
Réponses
17
Affichages
469
Réponses
3
Affichages
128
  • Question Question
Microsoft 365 Vba
Réponses
3
Affichages
190
Retour