• Publicité

MACRO : Enregister un classeur sans formules puis adaptation

Dans ce forum, vous pouvez poser toutes vos questions concernant l'utilisation de logiciels de bureautique (Microsoft Office, Open Office, etc.)

Modérateurs: Sebastien, Stéphane, Christophe

MACRO : Enregister un classeur sans formules puis adaptation

Messagepar anonymous9 » 09 Mar 2016 16:03

Bonjour,


Je rencontre quelques soucis suite à des adaptations que je souhaite faire dans la cette macro. Etant peu doué je n'y arrive pas.

- Mon fichier source : plusieurs feuilles dont une protégé par mot de passe et les autres feuilles sont protégés mais sans mot de passe.

Je souhaite incorporer dans la macro ces étapes :

- Enlever le mot de passe de la 1ere feuille puis les protections des autres feuilles pour que la copie de toutes les feuilles se fassent dans le nouveau fichier. Le nouveau fichier n'est pas obligé d'avoir les protections et le mot de passe comme dans le fichier source.

- Une fois la copie faite dans le nouveau fichier je souhaite que dans le fichier source le mot de passe soit remis dans la 1ère feuille et les protections dans les autres feuilles.

Des petits plus très intéressant si c'est possible :

- Comment faire pour copier le nom du fichier source et renommer le nouveau fichier avec le même nom, par contre je souhaite rajouter du texte en plus.
- Création automatique d'un mail avec outlook 2013
- Dans ce mail je souhaite rajouter le nouveau fichier en pièce jointe
- Dans ce mail je souhaite copier un texte qui est dans une cellule du fichier source pour le mettre dans l'objet du mail en rajoutant aussi du texte en plus.
- Si je peux aussi rajouter un destinataire au mail, ça serai parfait.

Si quelqu'un peut m'aider à compléter la macro et la modifier pour faire tout cela, un grand merci

Code: Tout sélectionner
Sub Sauvegarde_PVTU()
'
' Sauvegarde des résultats
'
' Touche de raccourci du clavier: Ctrl+Maj+Q
'
    Dim srcBook As Workbook
    Dim tgtBook As Workbook
    Dim iSheet As Integer
    Dim srcSheet As Worksheet
    Dim tgtSheet As Worksheet
    Dim rngData As Range
    Dim iRow As Integer
 
    ' Créer un nouveau classeur
    Set srcBook = Application.ThisWorkbook
    Set tgtBook = Application.Workbooks.Add
    ' Sur la liste des onglets du classeur en cours
    For Each srcSheet In srcBook.Worksheets
        ' Créer un nouvel onglet si nécessaire
        iSheet = srcBook.Worksheets(srcSheet.Name).Index
        If iSheet > tgtBook.Worksheets.Count Then
            Set tgtSheet = tgtBook.Worksheets.Add(, tgtBook.Worksheets(iSheet - 1))
        Else
            Set tgtSheet = tgtBook.Worksheets(iSheet)
        End If
        ' Déprotéger l'onglet source et copier les cellules renseignées
        srcSheet.Unprotect
        Set rngData = srcSheet.Range("A1", srcSheet.Cells.SpecialCells(xlLastCell))
        rngData.Copy
        ' Recopier dans le nouvel onglet la valeur des celules, leur format et le format des colonnes
        With tgtSheet.Range("A1")
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With
        ' Recopier son nom
        tgtSheet.Name = srcSheet.Name
        tgtSheet.Visible = srcSheet.Visible
        ' Masquer les lignes cachées ou recopier leur hauteur
        If tgtSheet.Visible Then
            For iRow = 1 To rngData.Rows.Count
                If rngData.Rows(iRow).Hidden Then
                    tgtSheet.Rows(iRow).Hidden = tgtSheet.Rows(iRow).Hidden
                Else
                    tgtSheet.Rows(iRow).RowHeight = rngData.Rows(iRow).RowHeight
                End If
            Next iRow
        End If
        ' Reprotéger la source
        Application.CutCopyMode = False
        srcSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=False, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
    Next srcSheet
End Sub
anonymous9
No0b
No0b
 
Messages: 3
Enregistré le: 09 Mar 2016 15:57

Re: MACRO : Enregister un classeur sans formules puis adapta

Messagepar Sebastien » 09 Mar 2016 19:26

Bonjour,

anonymous9 a écrit:Je souhaite incorporer dans la macro ces étapes :

- Enlever le mot de passe de la 1ere feuille puis les protections des autres feuilles pour que la copie de toutes les feuilles se fassent dans le nouveau fichier. Le nouveau fichier n'est pas obligé d'avoir les protections et le mot de passe comme dans le fichier source.

- Une fois la copie faite dans le nouveau fichier je souhaite que dans le fichier source le mot de passe soit remis dans la 1ère feuille et les protections dans les autres feuilles.


Voici une proposition pour résoudre le problème de déverrouillage/verrouillage de la feuille source avec ou sans mot de passe selon le cas :

Code: Tout sélectionner
Sub Sauvegarde_PVTU()
'
' Sauvegarde des résultats
'
' Touche de raccourci du clavier: Ctrl+Maj+Q
'
    Dim srcBook As Workbook
    Dim tgtBook As Workbook
    Dim iSheet As Integer
    Dim srcSheet As Worksheet
    Dim tgtSheet As Worksheet
    Dim rngData As Range
    Dim iRow As Integer
 
    ' Créer un nouveau classeur
    Set srcBook = Application.ThisWorkbook
    Set tgtBook = Application.Workbooks.Add
    ' Sur la liste des onglets du classeur en cours
    For Each srcSheet In srcBook.Worksheets
        ' Créer un nouvel onglet si nécessaire
        iSheet = srcBook.Worksheets(srcSheet.Name).Index
        If iSheet > tgtBook.Worksheets.Count Then
            Set tgtSheet = tgtBook.Worksheets.Add(, tgtBook.Worksheets(iSheet - 1))
        Else
            Set tgtSheet = tgtBook.Worksheets(iSheet)
        End If
        ' Déprotéger l'onglet source et copier les cellules renseignées
        '---------------------------
        If iSheet = 1 Then
            '### Retrait de la protection et du mot de passe sur la première feuille###
            srcSheet.Unprotect "mdp"
        Else
            '### Retrait de la protection pour les autres feuilles###
            srcSheet.Unprotect
        End If
        '---------------------------
        Set rngData = srcSheet.Range("A1", srcSheet.Cells.SpecialCells(xlLastCell))
        rngData.Copy
        ' Recopier dans le nouvel onglet la valeur des celules, leur format et le format des colonnes
        With tgtSheet.Range("A1")
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With
        ' Recopier son nom
        tgtSheet.Name = srcSheet.Name
        tgtSheet.Visible = srcSheet.Visible
        ' Masquer les lignes cachées ou recopier leur hauteur
        If tgtSheet.Visible Then
            For iRow = 1 To rngData.Rows.Count
                If rngData.Rows(iRow).Hidden Then
                    tgtSheet.Rows(iRow).Hidden = tgtSheet.Rows(iRow).Hidden
                Else
                    tgtSheet.Rows(iRow).RowHeight = rngData.Rows(iRow).RowHeight
                End If
            Next iRow
        End If
        ' Reprotéger la source
        Application.CutCopyMode = False
        '----------------------------
        If iSheet = 1 Then
        '### Protection avec mot de passe sur la première feuille###
            srcSheet.Protect Password:="mdp", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=False, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
        Else
        '### Protection des autres feuilles###
            srcSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=False, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
        End If
        '----------------------------
        Next srcSheet
End Sub


J'ai ajouté un bout de code qui met une condition :
si on traite la première feuille, on supprime protection et mot de passe ou sinon, on supprime juste la protection.
Puis à la fin on remet le mot de passe + protection si on traite la feuille 1, et juste la protection pour les autres feuilles.

Attention tout de même car toute personne qui aura accès à VBA pourra voir le mot de passe.
Dans la macro, on considère que le mot de passe est : mdp

@+
Image
Avatar de l’utilisateur
Sebastien
Administrateur
Administrateur
 
Messages: 5506
Enregistré le: 14 Fév 2005 19:17
Localisation: LILLE

Re: MACRO : Enregister un classeur sans formules puis adapta

Messagepar anonymous9 » 13 Mar 2016 21:15

Bonsoir,

Un grand merci pour la rapidité et pour l'aide.

Par contre j'ai dû supprimer cette ligne de commande
Code: Tout sélectionner
tgtSheet.Visible = srcSheet.Visible
car à a chaque fois ça bloquait, j'ai cherché mais je ne sais pas pourquoi. En enlevant cette commande la macro fonctionne très bien :-)

Pour les autres demandes avec outllook ? je suppose que ça demande beaucoup de travail pour les rajouter à la macro ?
anonymous9
No0b
No0b
 
Messages: 3
Enregistré le: 09 Mar 2016 15:57

Re: MACRO : Enregister un classeur sans formules puis adapta

Messagepar Sebastien » 13 Mar 2016 22:00

Bonjour,
anonymous9 a écrit:Pour les autres demandes avec outllook ? je suppose que ça demande beaucoup de travail pour les rajouter à la macro ?

Je ne sais pas le temps que ça peut prendre, c'est une partie de VBA que je ne connais pas encore. Je vais essayer de faire quelques tests pour voir si un bout de code peut permettre d'envoyer des mails. La difficulté sera à mon avis de ne pas être topé en tant que SPAM par Windows (une macro Excel qui envoi des mails, j'ai peur que l'antivirus trouve ça suspect).

Je reposterai si je trouve quelque chose. De votre coté si vous trouvez une solution, n'hésitez pas à la partager avec tout le monde.

@+
Image
Avatar de l’utilisateur
Sebastien
Administrateur
Administrateur
 
Messages: 5506
Enregistré le: 14 Fév 2005 19:17
Localisation: LILLE


Retourner vers Forum d'entraide : Bureautique

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 3 invités

  • Publicité