Execution de macro sur feuille protégée

Le 16/05/2022 à 11:09

Bonjour, j'ai un classeur avec plusieurs feuilles exécutant des macros.

J'ai protégé ces feuilles pour éviter que quiconque remplissent mal les cellules.

pour la plupart cela fonctionne sauf 2 :

dans l'une d’entre elles il y a une cellule dans laquelle on peut inscrire un mot de passe qui sert à ouvrir le classeur et qui comporte 2 boutons (je n'arrive pas à le faire avec un seul) pour masquer ou afficher ce mot de passe. Cette macro ne veut pas s’exécuter tandis que sur la même page d'autres boutons fonctionnent. Ce code apparait lorsque j’appuie sur "masquer"

masquer

et celui lorsque j'appuie sur "afficher"

afficher

voici le code utilisé pour toute la feuille, le problème ce pose avec les boutons 4 et 5 :

Sub MacroavecfeuilleProtect()

    ActiveSheet.Unprotect "mot de passe"

'Placez ici vos instructions

    ActiveSheet.Protect "mot de passe", True, True, True

End Sub
Private Sub CommandButton1_Click()
Dim ChoixDossier As String

If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
End If
Range("B18") = ChoixDossier & "\"

End Sub

Private Sub CommandButton2_Click()
Dim ChoixDossier As String

If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
End If
Range("B19") = ChoixDossier & "\"

End Sub

Private Sub CommandButton3_Click()
ThisWorkbook.Save
Sheets("Accueil").Activate
UserForm1.Show

End Sub

Private Sub CommandButton4_Click()
ThisWorkbook.Sheets("Pamamètres").Range("B17").Font.Color = RGB(255, 255, 255)

End Sub

Private Sub CommandButton5_Click()
ThisWorkbook.Sheets("Paramètres").Range("B17").Font.Color = xAlone

End Sub

Private Sub CommandButton6_Click()
Range("B18").ClearContents
End Sub

Private Sub CommandButton7_Click()
Range("B19").ClearContents
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.DisplayFullScreen = True
    ActiveWindow.DisplayWorkbookTabs = False
    Application.DisplayFormulaBar = False

End Sub

Pour la deuxième feuille, c'est pire, elle est censé s'ouvrir avec un bouton sur un userform mais cela ne s’exécute pas et j'ai le message suivant.

capture

Avec ce code :

Sub MacroavecfeuilleProtect()

    ActiveSheet.Unprotect "mot de passe"

'Placez ici vos instructions

    ActiveSheet.Protect "mot de passe", True, True, True

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.DisplayFullScreen = True
    ActiveWindow.DisplayWorkbookTabs = False
    Application.DisplayFormulaBar = False

End Sub
Private Sub CommandButton1_Click()
Dim wb As Workbook
Sheets("Bon de commande").Activate
Range("D15").Select
Sheets("Accueil").Activate
UserForm1.Show
End Sub

Private Sub CommandButton3_Click()

    Dim nomFichier As String
    Dim cheminFichier As String
    Dim CorpsMessage As String
'------------------------------------
'------Vider la colonne 1 -----------
    Worksheets("Bon de commande").Range("A1:A65536").Delete Shift:=xlUp
    '------------------------------------

    If MsgBox("Confirmez-vous l'envoi du bon de commande VL pour le garage" & " " & Range("C21").Value & " ?", vbYesNo + vbExclamation, "Voulez-vous continuer ?") = 7 Then Exit Sub
    'Code à exécuter si OUI

   nomFichier = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "-" & Range(" D15") & "-" & Range("C21") & ".pdf"
    cheminFichier = Sheets("Paramètres").Cells(18, 2).Text & nomFichier

    Cells(1, 1) = cheminFichier

    ActiveSheet.Range("B1:E31").Select ' la plage de cellules à envoyer

    ' Partie du code permettant l'enregistrement du fichier
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=cheminFichier, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
' Partie permettant de joindre d'autres fichiers
    If MsgBox("Voulez-vous joindre d'autres fichiers ?", vbYesNo + vbExclamation, "Joindre des fichiers") = 7 Then GoTo Line1 Else GoTo Line2

    ' Partie permettant l'envoi avec pièce jointe
Line2:
Dim CheminEtTypeFichier As String, Fichier As String
'Variable à définir : Le chemin par défaut
CheminEtTypeFichier = "D:\"

Fichier = BrowseFile(CheminEtTypeFichier)
GoTo Line3:

Line1:

Line3:

'-------- Nombre d'attachements------------------------------------------
c = Application.WorksheetFunction.CountA(Columns(1))
'------------------------------------------------------------------------
'------------------------------------------------------------------------

Dim ObjOutlook As Object
Set ObjOutlook = CreateObject("outlook.application")

Destinataire1 = Sheets("Paramètres").Cells(11, 2).Text
Destinataire2 = ActiveSheet.Cells(22, 2).Text

Set oBjMail = ObjOutlook.CreateItem(olMailItem)
        With oBjMail

            .To = Destinataire1
            .CC = Destinataire2
            .Subject = Range("C8") & "-" & Range("G17") & "/" & Range("D15")
            .Body = "Bonjour," & vbCrLf & vbCrLf _
                    & "Veuillez trouver ci-joint le bon de commande pour le véhicule" & " " & Range("D15").Value & vbCrLf & vbCrLf _
                    & "Cordialement" & vbCrLf & vbCrLf _
                    & Range("E10") & vbCrLf_

'-------- Insérer les attachements---------------------------------------
            For k = 2 To c
            D = ActiveSheet.Cells(k, 1)
            .Attachments.Add D
            Next k
'------------------------------------------------------------------------

            .Attachments.Add cheminFichier '& Fichier '& ".pdf"  'pièces jointes
            .Send

     ' Partie fermeture

        Range("D15,F15,C19,C21,C24").Value = ""

      Sheets("Accueil").Activate
UserForm1.Show

    End With
End Sub

Private Sub CommandButton4_Click()

 Dim nomFichier As String
    Dim cheminFichier As String
    Dim CorpsMessage As String
'------------------------------------
'------Vider la colonne 1 -----------
    ActiveSheet.Cells(1, 1).ClearContents
'------------------------------------

    If MsgBox("Confirmez-vous l'envoi du bon de commande PL pour le garage" & " " & Range("C21").Value & " ?", vbYesNo + vbExclamation, "Voulez-vous continuer ?") = 7 Then Exit Sub
    'Code à exécuter si OUI

   nomFichier = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "-" & Range(" D15") & "-" & Range("C21") & ".pdf"
    cheminFichier = Sheets("Paramètres").Cells(18, 2).Text & nomFichier

    Cells(1, 1) = cheminFichier

    ActiveSheet.Range("B1:E31").Select ' la plage de cellules à envoyer

    ' Partie du code permettant l'enregistrement du fichier
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=cheminFichier, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
' Partie permettant de joindre d'autres fichiers
    If MsgBox("Voulez-vous joindre d'autres fichiers ?", vbYesNo + vbExclamation, "Joindre des fichiers") = 7 Then GoTo Line1 Else GoTo Line2

    ' Partie permettant l'envoi avec pièce jointe
Line2:
Dim CheminEtTypeFichier As String, Fichier As String
'Variable à définir : Le chemin par défaut
CheminEtTypeFichier = "D:\"

Fichier = BrowseFile(CheminEtTypeFichier)
GoTo Line3:

Line1:

Line3:

'-------- Nombre d'attachements------------------------------------------
c = Application.WorksheetFunction.CountA(Columns(1))
'------------------------------------------------------------------------
'------------------------------------------------------------------------

Dim ObjOutlook As Object
Set ObjOutlook = CreateObject("outlook.application")

Destinataire1 = Sheets("Paramètres").Cells(14, 2).Text
Destinataire2 = ActiveSheet.Cells(22, 2).Text

Set oBjMail = ObjOutlook.CreateItem(olMailItem)
        With oBjMail

            .To = Destinataire1
            .CC = Destinataire2
            .Subject = Range("C8") & "-" & Range("G17") & "/" & Range("D15")
            .Body = "Bonjour," & vbCrLf & vbCrLf _
                    & "Veuillez trouver ci-joint le bon de commande pour le véhicule" & " " & Range("D15").Value & vbCrLf & vbCrLf _
                    & "Cordialement" & vbCrLf & vbCrLf _
                    & Range("E10") & vbCrLf_

'-------- Insérer les attachements---------------------------------------
            For k = 2 To c
            D = ActiveSheet.Cells(k, 1)
            .Attachments.Add D
            Next k
'------------------------------------------------------------------------

            .Attachments.Add cheminFichier '& Fichier '& ".pdf"  'pièces jointes
            .Send

     ' Partie fermeture

        Range("D15,F15,C19,C21,C24").Value = ""

        Sheets("Accueil").Activate
UserForm1.Show

    End With
End Sub
Function BrowseFile(CheminEtTypeFichier) As String

With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisir un fichier "
'Empêcher la multi-sélection
.AllowMultiSelect = True
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définit une liste de filtres pour le champ "Type de fichiers".
.Filters.Add "tous type", "*.*"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boîte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boîte de dialogue
.Show

If .SelectedItems.Count > 0 Then
For j = 1 To .SelectedItems.Count
Cells(j + 1, 1) = .SelectedItems(j)
Next
Else
BrowseFile = ""
End If
End With
End Function

Sachant que tout fonctionne parfaitement lorsque je ne protège pas mes feuilles.

Esperant avoir été assez clair.

Cela fait peut etre beaucoup, mais si quelqu'un peut m'aider ce ne serait pas de refus.

Par avance merci.

Le 16/05/2022 à 11:35

Bonjour,

Question con, mais est ce que ce serait pas du au fait que le code de dé-protection est dans une macro à part, qui protège à nouveau la feuille lors de l’exécution ? Donc forcément, si vous ne retirez pas la protection de vos feuilles directement dans les macros en question, ça ne fonctionnera pas !

Le 16/05/2022 à 13:57

Les feuilles à protéger sont au nombre de 2, elles ont chacune le code de protection dans leur macro respective. Cependant j'utilise le même mot de passe...

Le 16/05/2022 à 13:59
Thierry60440 a écrit :

Les feuilles à protéger sont au nombre de 2, elles ont chacune le code de protection dans leur macro respective. Cependant j'utilise le même mot de passe...

Je reformule ma remarque : il n'y a aucune instruction de retrait des protections dans les macros CommandButton_Click... Par conséquent, c'est normal que rien ne fonctionne derrière.

Le 17/05/2022 à 08:03

Merci de m'avoir orienté, ça fonctionne.

Rechercher des sujets similaires à "execution macro feuille protegee"