web-dev-qa-db-fra.com

Comment utiliser VBA SaveAs sans fermer le classeur d'appel?

Je veux:

  • Effectuer une manipulation de données à l'aide d'un classeur de modèle
  • Enregistrer une copie de ce livre de travail au format .xlsx ( SaveCopyAs ne vous permet pas de changer de type de fichier, sinon ce serait génial)
  • Continuer à afficher le modèle d'origine (pas celui "enregistré sous")

Utiliser SaveAs fait exactement ce qui est attendu - il enregistre le classeur tout en supprimant les macros et me présente la vue du classeur SavedAs nouvellement créé. 

Cela signifie malheureusement:

  • Je ne visualise plus mon classeur prenant en charge les macros à moins de le rouvrir.
  • L’exécution du code s’arrête à ce stade car
  • Toutes les modifications de macro sont ignorées si j'oublie de sauvegarder (note: pour un environnement de production, c'est ok, mais pour le développement, c'est très pénible)

Est-ce qu'il y a un moyen de faire ça?

'current code
Application.DisplayAlerts = False
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
templateWb.Activate
Application.DisplayAlerts = True

'I don't really want to make something like this work (this fails, anyways)
Dim myTempStr As String
myTempStr = ThisWorkbook.Path & "\" & ThisWorkbook.Name
ThisWorkbook.Save
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Workbooks.Open (myTempStr)

'I want to do something like:
templateWb.SaveCopyAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'SaveCopyAs only takes one argument, that being FileName

Notez également que SaveCopyAs me permettra de le sauvegarder sous un type différent (c.-à-d. templateWb.SaveCopyAs FileName:="myXlsx.xlsx"). Cela produira une erreur lors de son ouverture car il a maintenant un format de fichier non valide.

excelvbaexcel-vbasave
12
enderland

J'ai fait quelque chose de similaire à ce que Siddharth avait suggéré et écrit une fonction pour le faire, ainsi que pour gérer certains désagréments et offrir plus de flexibilité.

Sub saveExample()
    Application.ScreenUpdating = False

    mySaveCopyAs ThisWorkbook, "C:\Temp\testfile2", xlOpenXMLWorkbook

    Application.ScreenUpdating = True
End Sub

Private Function mySaveCopyAs(pWorkbookToBeSaved As Workbook, pNewFileName As String, pFileFormat As XlFileFormat) As Boolean

    'returns false on errors
    On Error GoTo errHandler



     If pFileFormat = xlOpenXMLWorkbookMacroEnabled Then
        'no macros can be saved on this
        mySaveCopyAs = False
        Exit Function
    End If

    'create new workbook
    Dim mSaveWorkbook As Workbook
    Set mSaveWorkbook = Workbooks.Add

    Dim initialSheets As Integer
    initialSheets = mSaveWorkbook.Sheets.Count


    'note: sheet names will be 'Sheet1 (2)' in copy otherwise if
    'they are not renamed
    Dim sheetNames() As String
    Dim activeSheetIndex As Integer
    activeSheetIndex = pWorkbookToBeSaved.ActiveSheet.Index

    Dim i As Integer
    'copy each sheet
    For i = 1 To pWorkbookToBeSaved.Sheets.Count
        pWorkbookToBeSaved.Sheets(i).Copy After:=mSaveWorkbook.Sheets(mSaveWorkbook.Sheets.Count)
        ReDim Preserve sheetNames(1 To i) As String
        sheetNames(i) = pWorkbookToBeSaved.Sheets(i).Name
    Next i

    'clear sheets from new workbook
    Application.DisplayAlerts = False
    For i = 1 To initialSheets
        mSaveWorkbook.Sheets(1).Delete
    Next i

    'rename stuff
    For i = 1 To UBound(sheetNames)
        mSaveWorkbook.Sheets(i).Name = sheetNames(i)
    Next i

    'reset view
    mSaveWorkbook.Sheets(activeSheetIndex).Activate

    'save and close
    mSaveWorkbook.SaveAs FileName:=pNewFileName, FileFormat:=pFileFormat, CreateBackup:=False
    mSaveWorkbook.Close
    mySaveCopyAs = True

    Application.DisplayAlerts = True
    Exit Function

errHandler:
    'whatever else you want to do with error handling
    mySaveCopyAs = False
    Exit Function


End Function
5
enderland

Voici une méthode beaucoup plus rapide que d'utiliser .SaveCopyAs pour créer une copie, puis l'ouvrir et faire une sauvegarde sous ...

Comme mentionné dans mes commentaires, ce processus prend environ 1 seconde pour créer une copie xlsx à partir d'un classeur comportant 10 feuilles de calcul (chacune contenant 100 lignes * 20 colonnes).

Sub Sample()
    Dim thisWb As Workbook, wbTemp As Workbook
    Dim ws As Worksheet

    On Error GoTo Whoa

    Application.DisplayAlerts = False

    Set thisWb = ThisWorkbook
    Set wbTemp = Workbooks.Add

    On Error Resume Next
    For Each ws In wbTemp.Worksheets
        ws.Delete
    Next
    On Error GoTo 0

    For Each ws In thisWb.Sheets
        ws.Copy After:=wbTemp.Sheets(1)
    Next

    wbTemp.Sheets(1).Delete
    wbTemp.SaveAs "C:\Blah Blah.xlsx", 51

LetsContinue:
    Application.DisplayAlerts = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
5
Siddharth Rout

J'ai un processus similaire, voici la solution que j'utilise. Il permet à l'utilisateur d'ouvrir un modèle, d'effectuer des manipulations, de sauvegarder le modèle quelque part, puis d'ouvrir le modèle d'origine.

  1. l'utilisateur ouvre un fichier de modèle activé par macro
  2. faire des manipulations
  3. enregistrer le chemin de fichier d'ActiveWorkbook (fichier de modèle)
  4. exécuter un SaveAs
  5. définir ActiveWorkbook (maintenant le fichier saveas'd) en tant que variable 
  6. ouvrir le chemin du fichier de modèle à l'étape 3
  7. ferme la variable à l'étape 5

le code ressemble à ceci:

    'stores file path of activeworkbook BEFORE the SaveAs is executed
    getExprterFilePath = Application.ActiveWorkbook.FullName

    'executes a SaveAs
    ActiveWorkbook.SaveAs Filename:=filepathHere, _
    FileFormat:=51, _
    Password:="", _
    WriteResPassword:="", _
    ReadOnlyRecommended:=False, _
    CreateBackup:=False

    'reenables alerts
    Application.DisplayAlerts = True


    'announces completion to user
    MsgBox "Export Complete", vbOKOnly, "List Exporter"             


    'sets open file (newly created file) as variable
    Set wbBLE = ActiveWorkbook

    'opens original template file
    Workbooks.Open (getExprterFilePath)

    'turns screen updating, calculation, and events back on
    With Excel.Application
        .ScreenUpdating = True
        .Calculation = Excel.xlAutomatic
        .EnableEvents = True
    End With

    'closes saved export file
    wbBLE.Close
1
arbitel

Ce processus dans Excel VBA n’a rien de joli ni de sympa, mais quelque chose comme l’observation ci-dessous… .. Ce code ne traite pas très bien les erreurs, est moche, mais devrait fonctionner.

Nous copions le classeur, ouvrons et enregistrez la copie, puis supprimons la copie. La copie temporaire est stockée dans votre répertoire temporaire local et également supprimée.

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" _
         Alias "GetTempPathA" (ByVal nBufferLength As Long, _
         ByVal lpBuffer As String) As Long

Public Sub SaveCopyAs(TargetBook As Workbook, Filename, FileFormat, CreateBackup)
  Dim sTempPath As String * 512
  Dim lPathLength As Long
  Dim sFileName As String
  Dim TempBook As Workbook
  Dim bOldDisplayAlerts As Boolean
  bOldDisplayAlerts = Application.DisplayAlerts
  Application.DisplayAlerts = False

  lPathLength = GetTempPath(512, sTempPath)
  sFileName = Left$(sTempPath, lPathLength) & "tempDelete_" & TargetBook.Name

  TargetBook.SaveCopyAs sFileName

  Set TempBook = Application.Workbooks.Open(sFileName)
  TempBook.SaveAs Filename, FileFormat, CreateBackup:=CreateBackup
  TempBook.Close False

  Kill sFileName
  Application.DisplayAlerts = bOldDisplayAlerts
End Sub
1
AndASM

Une autre option (testé uniquement sur les dernières versions d'Excel).

Les macros ne sont pas supprimées tant que le classeur n'est pas fermé après une SaveAs.xlsx. Vous pouvez ainsi exécuter deux SaveAs successives sans fermer le classeur.

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges
Application.DisplayAlerts = True

Remarque: vous devez désactiver la DisplayAlerts pour éviter de recevoir l'avertissement que le classeur existe déjà lors de la deuxième sauvegarde.

0
OSKM