Oter une protection VBA sur bouton en ayant une condition

Le 09/05/2022 à 19:08

Bonjour les exceliens et exceliennes!

Je viens suite à quelques heures de recherches sans réponse.

Je souhaiterai que ma macro se lance SEULEMENT si la cellule I46 est SUPÉRIEUR à 0.

SACHANT que mes feuilles sont protégé par un code.

Je vous met le code complet ci-dessous (les lignes correspondantes sont la : 2, 3eme lignes et l'avant dernière ligne)

Sub Archiver_achat()

If Sheets("facture").Range("I46") = 0 Then Exit Sub

ActiveSheet.Unprotect Password:="XXX"

For Each Item In Sheets("Facture").Range("B25:B37")
If Item.Value = "" Then
'ne rien faire
Else
'archiver l'article
ligneA = Sheets("Historique achat").Range("A2").End(xlDown).Row + 1
ligneB = Item.Row
Sheets("Historique achat").Range("A" & ligneA).Value = Sheets("Facture").Range("C13").Value
Sheets("Historique achat").Range("B" & ligneA).Value = Sheets("Facture").Range("C14").Value
Sheets("Historique achat").Range("C" & ligneA).Value = Sheets("Facture").Range("H4").Value
Sheets("Historique achat").Range("D" & ligneA).Value = Sheets("Facture").Range("H6").Value
Sheets("Historique achat").Range("E" & ligneA).Value = Sheets("Facture").Range("H7").Value
Sheets("Historique achat").Range("F" & ligneA).Value = Sheets("Facture").Range("H9").Value
Sheets("Historique achat").Range("K" & ligneA).Value = Sheets("Facture").Range("I46").Value

Sheets("Historique achat").Range("G" & ligneA).Value = Sheets("Facture").Range("B" & ligneB).Value
Sheets("Historique achat").Range("H" & ligneA).Value = Sheets("Facture").Range("G" & ligneB).Value
Sheets("Historique achat").Range("I" & ligneA).Value = Sheets("Facture").Range("F" & ligneB).Value
Sheets("Historique achat").Range("J" & ligneA).Value = Sheets("Facture").Range("H" & ligneB).Value

End If
Next Item

'calcul du nouveau numéro de facture

Sheets("Facture").Range("C13").Value = Sheets("Facture").Range("C13").Value + 1
Sheets("Facture").Range("E17").ClearContents
Sheets("Facture").Range("E19:E20").ClearContents
Sheets("Facture").Range("H17:H18").ClearContents
Sheets("Facture").Range("I17:I18").ClearContents
Sheets("Facture").Range("I20:I22").ClearContents
Sheets("Facture").Range("B25:B32").ClearContents
Sheets("Facture").Range("G25:G32").ClearContents

ActiveSheet.Protect Password:="XXXX"

End Sub

Merci de votre réponse,

Léo

Le 09/05/2022 à 19:23

Bonjour Léo alias lrclx et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum

Concernant votre demande, si vous souhaitez tester une valeur numérique il faut faire

If Sheets("facture").Range("I46") <= 0 Then Exit Sub

Merci de votre participation

Cordialement

Le 09/05/2022 à 19:48

Merci de ta réponse!

Concernant la présentation, c'est fait! ;)

Sinon, ça ne résout pas mon problème. Même en changeant le chiffre, cela me dis que la page est protégé par un mot de passe...

Le 09/05/2022 à 19:52

Quand je clique sur le bouton et que la cellule est vide, rien ne se passe (la condition à bien été pris en compte)

Mais si la cellule est remplie, cela m'affiche un message comme quoi que la feuille est protégé par un mot de passe. et ne lance donc pas ma macro..

Le 09/05/2022 à 20:05

Bonjour le fil, bonjour le forum,

Comme tu ne fournis pas le fichier qui va bien on est intrigués par ta question. Peut-être comme ça :

Sub Archiver_achat()
Dim OF As Worksheet
Dim OHA As Worksheet
Dim CEL As Range
Dim ligneA As Integer
Dim ligneB As Integer

Set OF = Worksheets("facture")
Set OHA = Worksheets("Historique achat")

If OF.Range("I46").Value = "" Then Exit Sub
If OF.Range("I46").Value > 0 Then
    ActiveSheet.Unprotect Password:="XXX" '? on ne sait pas quel est l'onglet actif sans le fichier, ne serait-il pas plus judicieux de le nommer ?
    For Each CEL In OF.Range("B25:B37") 'boucle sur tous les cellules CEl de la plage B25:B37 de l'onglet OF
    If CEL.Value <> "" Then 'conditio
    'archiver l'article
    ligneA = OHA.Range("A2").End(xlDown).Row + 1
    ligneB = CEL.Row
    OHA.Range("A" & ligneA).Value = OF.Range("C13").Value
    OHA.Range("B" & ligneA).Value = OF.Range("C14").Value
    OHA.Range("C" & ligneA).Value = OF.Range("H4").Value
    OHA.Range("D" & ligneA).Value = OF.Range("H6").Value
    OHA.Range("E" & ligneA).Value = OF.Range("H7").Value
    OHA.Range("F" & ligneA).Value = OF.Range("H9").Value
    OHA.Range("K" & ligneA).Value = OF.Range("I46").Value
    OHA.Range("G" & ligneA).Value = OF.Range("B" & ligneB).Value
    OHA.Range("H" & ligneA).Value = OF.Range("G" & ligneB).Value
    OHA.Range("I" & ligneA).Value = OF.Range("F" & ligneB).Value
    OHA.Range("J" & ligneA).Value = OF.Range("H" & ligneB).Value
    End If
    Next CEL
    'calcul du nouveau numéro de facture
    OF.Range("C13").Value = OF.Range("C13").Value + 1
    OF.Range("E17").ClearContents
    OF.Range("E19:E20").ClearContents
    OF.Range("H17:H18").ClearContents
    OF.Range("I17:I18").ClearContents
    OF.Range("I20:I22").ClearContents
    OF.Range("B25:B32").ClearContents
    OF.Range("G25:G32").ClearContents
    ActiveSheet.Protect Password:="XXXX"
End If
End Sub
Le 09/05/2022 à 20:11

il y a un truc, avant la première fois que vous voulez executer votre macro, il faut faire le truc suivante, mais cela a une durée limitée (jusqu'au moment ou le fichier est fermé), donc préferable d'ajouter cela dans Thisworkbook Workbook_open !

Private Sub Workbook_Open()
     With Sheets("facture")     'seulement une fois par session
          .Unprotect "XXX"
          .Protect "XXX", userinterfaceonly:=True     'macros peuvent faire leur job, même si cette feuille est protegée
     End With
End Sub

Puis dans tous vos macros, il n'y a plus de nécesité de "unprotect"-"protect" !

le macro peut être simplifier comme ceci (mais il y a encore des possibilités d'amelioration)

Sub Archiver_achat()

     Set Sh = Sheets("facture")
     If Sh.Range("I46") = 0 Then Exit Sub

     For Each Item In Sh.Range("B25:B37")
          If Item.Value = "" Then
     'ne rien faire
          Else
     'archiver l'article
               With Sheets("Historique achat")
                    ligneA = .Range("A2").End(xlDown).Row + 1
                    ligneB = Item.Row
                    .Range("A" & ligneA).Value = Sh.Range("C13").Value
                    .Range("B" & ligneA).Value = Sh.Range("C14").Value
                    .Range("C" & ligneA).Value = Sh.Range("H4").Value
                    .Range("D" & ligneA).Value = Sh.Range("H6").Value
                    .Range("E" & ligneA).Value = Sh.Range("H7").Value
                    .Range("F" & ligneA).Value = Sh.Range("H9").Value
                    .Range("K" & ligneA).Value = Sh.Range("I46").Value

                    .Range("G" & ligneA).Value = Sh.Range("B" & ligneB).Value
                    .Range("H" & ligneA).Value = Sh.Range("G" & ligneB).Value
                    .Range("I" & ligneA).Value = Sh.Range("F" & ligneB).Value
                    .Range("J" & ligneA).Value = Sh.Range("H" & ligneB).Value
               End With
          End If
     Next Item

     'calcul du nouveau numéro de facture

     Sh.Range("C13").Value = Sheets("Facture").Range("C13").Value + 1
     Sh.Range("E17,E19:E20,H17:H18,I17:I18,I20:I22,B25:B32,G25:G32").ClearContents

End Sub
Le 09/05/2022 à 21:46

Merci pour vos réponses, j'ai essayer de rentrer le code dans ThisWorkbook, mais rien y fais..

Le 10/05/2022 à 02:40

il faut sauvegarder le fichier, fermer et rouvrir et alors ce truc fonctionne.

Le 10/05/2022 à 07:59

Bonjour à tous,

@lrclx, je ne comprends pas ce fil
la demande initiale est "Je souhaiterai que ma macro se lance SEULEMENT si la cellule I46 est SUPÉRIEUR à 0"

Nous en sommes très loin il faudra m'expliquer !

Le 10/05/2022 à 11:00

Bonjour le fil, bonjour le forum,

Je plussoie Bruno ! Il faudrait nous expliquer...

Rechercher des sujets similaires à "oter protection vba bouton ayant condition"