Macro de sauvegarde

Le 25/01/2009 à 02:41

Bonjour le forum.

J'utilise une macro pour remettre a neuf ma feuille sans perdre les données importante.

Seulement, avant d'enclencher cette macro, j'aimerais créé une de sauvegarde.

Le fichier étant très lourd, j'aimerais que la sauvegarde soit de type .... valeur... qu'elle ne garde pas les formules et les macro (si possible). Le fichier a deux feuil (feuil1 et Archive).

Et finalement, j'aimerais que le nom de cette copie soit la date.

Merci d'avance.

Peri

Le 25/01/2009 à 13:11

Bonjour,

essaie ce code, à copier dans un module standard :

Sub sauv()
' Sauvegarde les 2 feuilles du fichier actuel
' Remplace les formules par leur valeur
' Supprime tous les codes
Dim LePath As String, LeNom As String
Dim Cel As Range, Sh As Worksheet
Dim VBComp As Variant
Dim VBComps As Variant

LePath = ActiveWorkbook.Path & "\"
LeNom = Format(Date, "yyyymmdd") & ".xls"
Sheets(Array("Feuil1", "Archive")).Copy
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
    Select Case VBComp.Type
        Case 1 To 3
            VBComps.Remove VBComp
        Case Else
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
            End With
    End Select
Next VBComp
On Error Resume Next
For Each Sh In Sheets
    For Each Cel In Sh.Cells.SpecialCells(xlCellTypeFormulas, 23)
        Cel.Value = Cel.Value
    Next Cel
Next Sh
On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs LePath & LeNom
ActiveWorkbook.Close
End Sub

Le 25/01/2009 à 16:24

Bonjour Felix

Je viens de tester ton code, il ne se termine jamais, j'ai dut le stopper moi même

En fait, je crois qu'il s'auto supprime lui même, ainsi que tous le reste du code du classeur.

(C'est peut être moi qui a fait quelque chose de pas correcte). Dans tous les cas, le code ne doit pas affecter thisworkbook.

Le mieux serait de copier les deux première feuille de thisworkbook et de les coller valeur et format dans un deuxième classeur. Sauvegarder se nouveau classeur avec la date.

RAnge a copier: Feuil1 : A1:AK1001 - Archive: A1:I1001 (Au cas ou).

Merci encore felix

Peri

Le 25/01/2009 à 16:35

Re,

excuse-moi, pour test, j'avais mis un apostrophe devant la ligne :

'Sheets(Array("Feuil1", "Archive")).Copy

Supprime l'apostrophe, et tu auras normalement ce que tu demandes.....

Le 25/01/2009 à 18:49

Rebonjour le forum et merci a Felix pour son aide

La macro arrive a copier les feuille dans un nouveau classeur, mais elle ne supprime qu'une petite partie de formule présente sur ma feuille ..

Cette ligne apparait en jaune: Next Cel

Merci encore une fois pour ton aide

Peri

Le 25/01/2009 à 18:52

Re-,

Aurais-tu des protections dans tes feuilles?

Le 25/01/2009 à 19:20

Bonjour Felix,

Oui j'ai des protection dans la feuille 1 mais elle ne sont pas sensé être affecté par les macro::

Private Sub Workbook_Open()

Sheets("Feuil1").Protect "Mdp", UserInterfaceOnly:=True

End Sub

Sinon, j'ai des lignes (beaucoup de ligne) masqué, si c'est ligne masquer nuise au bon fonctionnement de la macro, je peux les affiché facilement

Au plaisir de te relire.

Peri

Le 25/01/2009 à 19:37

Re,

je viens d'essayer, avec des protections, et des lignes masquées; et je n'ai aucun souci...

tu pourrais me donner l'adresse de Cel?

Le 25/01/2009 à 19:49

Re bonjour

Avec le débugeur, lorsque la ligne est souligner en jaune: cell = 0

Je tiens a dire que je n'ai pas d'erreur comme tel, la macro n'en fini tous simplement pas, je dois la stopper via ctrl+pause, et a se moment l'option débogage apparait.

Merci encore

Peri

Le 25/01/2009 à 20:24

Re-,

je ne comprends pas trop....

je t'envoie mon adresse mail, en MP

Si tu veux m'expédier ton fichier, je pourrai y jeter un oeil....

Le 25/01/2009 à 21:22

Pourquoi ne pas simplement créer des feuilles vierges et y copier les valeurs?

Le 26/01/2009 à 01:54

Salut le forum

Perigord, on va attendre les réponses de Felix, il va te répondre en MP.

Pas la peine de fournir d'autre code pour l'instant.

Mytå

Le 26/01/2009 à 01:59

Le contacte par Mp a été établis Merci Myta.

pour avoir tester et re tester le code, je crois que le problème viens simplement du temps d'exécution de la procédure. Mon fichier ayant un peu plus de 20 000 formules .... chaque fois que je stop la procédure, les cellule changer ne sont pas les même, j'ai dut laisser rouler une demi heure pour faire le quart de la page ^^

Merci encore a se fabuleux forum

Peri qui commence a se demander si Exel était la meilleur solution pour sont programme ^^

Le 26/01/2009 à 02:03

Re le forum

La méthode de traitement, n'est peut-etre pas la bonne de scanner tous les cellules.

Mytå

Le 26/01/2009 à 17:25

Bonsoir,

Effectivement, 20 000 formules, ça demande du temps...

Maintenant, un copier / collage spécial (valeurs) devrait demander autant de temps....

PS, Mytå, je ne scanne que les cellules contenant des formules, ce qui me semble plus rapide que le collage spécial, qui lui scannera Toutes les cellules....

A tester.....

Le 26/01/2009 à 18:33

Re,

après test....

Chez moi, 3 secondes et quelques....

Sub sauv()
' Sauvegarde les 2 feuilles du fichier actuel
' Remplace les formules par leur valeur
' Supprime tous les codes
Dim LePath As String, LeNom As String
Dim Cel As Range, Sh As Worksheet
Dim VBComp As Variant
Dim VBComps As Variant
LePath = ActiveWorkbook.Path & "\"
LeNom = Format(Date, "yyyymmdd") & ".xls"
Sheets(Array("Feuil1", "Archive")).Copy
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
    Select Case VBComp.Type
        Case 1 To 3
            VBComps.Remove VBComp
        Case Else
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
            End With
    End Select
Next VBComp
On Error Resume Next
For Each Sh In Sheets
    Sh.Cells.Copy
    Sh.Range("A1").PasteSpecial Paste:=xlPasteValues
Next Sh
On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs LePath & LeNom
ActiveWorkbook.Close
End Sub

Et effectivement, le collage spécial est bien plus rapide......

A te relire....

Le 26/01/2009 à 18:59

Salut le forum

Félix, tu as le programme essaye ceci.

Sub Test_Copie()
' Sauvegarde les 2 feuilles du fichier actuel
' Remplace les formules par leur valeur
' Supprime tous les codes
Dim LePath As String, LeNom As String
Dim MaPlage As Range, Sh As Worksheet
Dim VBComp As Variant
Dim VBComps As Variant

LePath = ActiveWorkbook.Path & "\"
LeNom = Format(Date, "yyyymmdd") & ".xls"
Sheets(Array("Feuil1", "Archive")).Copy
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
    Select Case VBComp.Type
        Case 1 To 3
            VBComps.Remove VBComp
        Case Else
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
            End With
    End Select
Next VBComp
On Error Resume Next
For Each Sh In Sheets
  Set MaPlage = Sh.Cells.SpecialCells(xlCellTypeFormulas, 23)
        MaPlage = MaPlage.Value
Next Sh
Set MaPlage = Nothing
On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs LePath & LeNom
ActiveWorkbook.Close
End Sub

Mytå

Edition : Copie du code complet