[résolu]Transfert de feuillets vers un nouveau classeur

[Al capone]

Bonjour à tous,

J'ai lu à gauche et droite pleins de trucs à gauche et droite mais pas tout saisi....
Actuellement j'effectue une copie d'un classeur entier (backup) avec le code suivant :

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\Backup"

mabackup = ThisWorkbook.Path & "\Backup" & "\sauv_" & Format(tmp1, "ddmmyyyy") & ".xls"
Montableau= ThisWorkbook.Path & "\principal.xls"

If Not objFSO.FileExists(mabackup) Then
ActiveWorkbook.SaveAs Filename:=mabackup
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Montableau
Application.DisplayAlerts = True

Celà marche bien et aucun message dérangeant. Là ou je bute est qu'en fait, dans un 3ième fichier excell, je n'aimerais pas avoir tous les feuillets comme dans principal.xls et ma backup actuelle mais n'en gardé que certains.

Ma macro est lancé depuis principal.xls et j'aimerais que tout se fasse en arrière plan.

Une piste serait de rouvrir en arrière plan ma backup en lecture seule par exemple, de virer l'onglet 1 et 3 par exemple et de l'enregistrer sous avec un autre nom avec le paramètre en lecture seul, de refermer ma backup afin que l'utilisateur une fois la macro terminée n'a que principal.xls sous les yeux.

Merci pôur votre aide

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

ReSalut, bon j'avance mais ai besoin de vous....

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=NomFichier 'j'enregistre l'original

Dim sh As Worksheet
For Each sh In Worksheets
    If InStr(1, "feuil1,feuil2,feuil3,  sh.Name) = 0 Then sh.Delete 
Next sh

ActiveWorkbook.SaveAs Filename:=RecapFile 'j'enregistre le fichier modifié

Application.DisplayAlerts = True

Le truc que j'arrive pas à faire est de rappeler le fichier Original complet tout en fermant le fichier modifié de manière la plus transparente possible....
Et le problème est qu'à chaque fois que j'ouvre le fichier principal, j'ai le problème de l'autorisation des macros

C'est pour celà que je pensais au départ ouvrir un nouveau classeur excell qui reste en arrière plan, copier les feuillets qui m'intéressent, l'enregistrer sous RecapFile et le fermer..Comme celà resterait ouvert et actif et en premier plan toujours mon classeur principal. Celà serait pour moi la meilleure solution.....

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

Bonsoir, bon j'ai réussi via le plan Z ....

1)Sauvegarde de l'original dans une récap
2)Sauvegarde de l'original
3)Ouverture de la récap/suppression des onglets non désirés

Jusque là tout marche... Reste à supprimer les macros de la récap avant de ré-enregistrer et de le refermer..... Le hic est que le code si-dessous me vire les macros de l'original et non de la recap que j'ai rouvert...Voici le code trouvé sur ce forum :

  'suppression macros
    '   Cocher Outils | Reférence Microsoft Visual Basic for Applications Extensibility 5.3
    
    Dim VBComp As VBIDE.VBComponent
    Dim VBComps As VBIDE.VBComponents

    Set VBComps = ThisWorkbook.VBProject.VBComponents

    For Each VBComp In VBComps
       Select Case VBComp.Type
          Case vbext_ct_StdModule, vbext_ct_MSForm, vbext_ct_ClassModule
                VBComps.Remove VBComp
          Case Else
                With VBComp.CodeModule
                   .DeleteLines 1, .CountOfLines
                End With
       End Select
    Next
    ' fin supression macros

Je pense que le problème vient de cette ligne :

Set VBComps = ThisWorkbook.VBProject.VBComponents

Je pense qu'il faut changer ThisWorkook par celui ou je veux virer les scripts. Pour info, mon dossier recap s'appelle "Recap_18072011.xls" par exemple.....

Edit : j'ai essayé en mettant cette ligne à la place :

Set VBComps = ActiveWorkbook.VBProject.VBComponents

Là j'ai un autre problème car sur mon classeur originale, le projet vba est protégé par un mot de passe. Donc sur la copie (récap....xls) aussi .... Donc je peux pas tester car je ne sais pas comment enlever par script la protection sur le classeur récap...xls

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

Re, Bon je me répond à moi même ... nouveau code + simple .....

ActiveWorkbook.SaveAs Filename:=NomFichier
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=RecapFile
    Workbooks(Recap).Close
    
    If objFSO.FileExists(RecapFile) Then
    
    On Error Resume Next

        Set wkB = Workbooks.Open(RecapFile)
    
    'Copier les feuilles
    ThisWorkbook.Sheets("Recap 1").Copy before:=wkB.Sheets(1)
    ActiveSheet.Name = ThisWorkbook.Sheets("Recap 1")
    ThisWorkbook.Sheets("Gestion ATE").Copy before:=wkB.Sheets(2)
    ActiveSheet.Name = ThisWorkbook.Sheets("Recap 2")
    ThisWorkbook.Sheets("Recap S").Copy before:=wkB.Sheets(3)
    ActiveSheet.Name = ThisWorkbook.Sheets("Recap 3")
    ThisWorkbook.Sheets("Recap F").Copy before:=wkB.Sheets(4)
    ActiveSheet.Name = ThisWorkbook.Sheets("Recap 4")
    ThisWorkbook.Sheets("Recap C").Copy before:=wkB.Sheets(5)
    ActiveSheet.Name = ThisWorkbook.Sheets("Recap 5")
    
    'Détruire les éventuels objets shapes  de la feuille
    For Each ctl In ActiveSheet.Shapes
        ctl.Delete
    Next
 
    ActiveWorkbook.SaveAs Filename:=RecapFile
    Workbooks(Recap).Close

Deux questions :

1) Comment avant la fermeture du Workbook(Recap) faire en sorte que lorsqu'on l'ouvre, il soit positionné sur la Recap 1 ?

2)Comment mettre un mot de passe sur le classeur entier Workbook(Recap) avant aussi sa fermeture car cette Recap n'est là que pour être consulté et ne doit pas être modifié sans connaitre le MDP

 

[Staple1600]

Re : Transfert de feuillets vers un nouveau classeur

Bonsoir

...car cette Recap n'est là que pour être consulté ...

Dans ce cas, pourquoi ne pas simplement exporter ton classeur en PDF ?

Cela simplifierai grandement les choses, non ?

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

Salut Staple,

Certains sont encore sous Excel 2002 .... Je sais qu'il existe la soluce avec PDF creator..... Mais je pensais qu'on pouvait protéger les feuilles par mot de passe directement dans la macro.

 

[Staple1600]

Re : Transfert de feuillets vers un nouveau classeur

BonsoiRe

Bien sur qu'on peut

Il suffit de le faire en laissant tourner l'enregisteur de macro
pour disposer du code VBA adéquat.

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

Re, Re, Re C'est bon pour la protection.... LOL j'alimente tout seul mon Topic .......

Me reste juste un truc ou je bute. Dans le code ci-dessus, je copie et obtiens les onglets : Recap1, Recap2, etc .....
L'onglet actif est donc le dernier le Recap5 . J'aimerais que l'onglet actif soit Recap1 avant que j'enregistre mon classeur Recap.

Please, help me

 

[Staple1600]

Re : Transfert de feuillets vers un nouveau classeur

Re

Juste pour info: tu peux te passer de ta boucle pour supprimer tes Shapes

ActiveSheet.Shapes.SelectAll: Selection.Delete

Même réponse que tout à l'heure: utilises l'enregistreur de macro !

 

[Al capone]

Re : Transfert de feuillets vers un nouveau classeur

Merci . J'ai une autre question mais je vais crée un autre sujet.