[VBA] SaveAs / Save .XLSM .XLS .XLTM etc

Bonjour à tous.

Je m'excuse si je suis à la limite du re-post. je galère avec les sauvegardes par VBA un pure casse-tête.

• Mes "Logiciels" sont enregistré au format .XLTM

-> Par défaut, lors de la première save le format doit être .XLSM (Sujet résolu ICI) Par contre, si nous somme déja sur un classeur XLSM la macro ne s'active pas.

Sur le fichier joint, il y a un bouton "Export sans macro" où je propose a l'utilisateur d'abord si il veux save le fichier actuel, puis par VBA supprime les boutons et réalise une save SANS VBA.

SI mon fichier est déjà en format XLSM tout fonctionne plutôt bien. Par contre, si je suis tjrs sur la version XLTM alors la rien ne fonctionne...

Lors que j'exécute en mode pas à pas, je ne comprend pas pourquoi les saves n'ont pas lieu je choisi l'emplacement mais le fichier ne s'enregistre pas. Parfois la macro me demande au moins 3 fois de save sans que rien ne se passe..

Merci infiniment à ceux qui aurons le courage de se plonger dans le code... (Module Export et Worksheet_BeforeSave)

A+

Bonjour Gabin37,

La sauvegarde d'un fichier modèle sans macro est plus compliquée que ce qu'il n'y parait

En effet, vous ne pouvez pas enregistrer un fichier en cours d'exécution en simple fichier ".xlsx"

Il faut donc passer par ce code (mis dans le fichier)

Option Explicit

Sub ExportExcel()
  Dim Sht As Worksheet, Wbk As Workbook
  Dim Img As Shape
  Dim sFic As String, sNewFic As String, sPathFic As String
  Dim Rep
  Rep = MsgBox("Vouslez-vous sauvegarder le classeur AVEC les macros avant l'export ?", vbQuestion + vbYesNoCancel + vbDefaultButton1, "")
  If Rep = vbYes Then ThisWorkbook.Save: Exit Sub
  GoTo Suite
  ' Si réponse NON
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets(1).Delete
  For Each Sht In ThisWorkbook.Worksheets
    Sht.Activate
    If Range("R22") = True And Range("S22") = True And Range("T22") = True And Range("U22") = True Then
      Sht.Unprotect
      For Each Img In Sht.Shapes
        If Img.BottomRightCell.Row < 34 Then Img.Delete
      Next Img
      If Sht.Name <> "Dico" Then Range("R3:U34").Clear
      Sht.Delete
    Else
      Sht.Unprotect
      For Each Img In Sht.Shapes
        If Img.BottomRightCell.Row < 34 Then Img.Delete
      Next Img
      If Sht.Name <> "Dico" Then Range("R3:U34").Clear
    End If
    If Sht.Name = "Dico" Then Sht.Visible = False
  Next Sht
  Application.EnableEvents = True
Suite:
  sPathFic = ThisWorkbook.Path & "\" & "Capabilité " & Range("A8")
  sFic = Application.GetSaveAsFilename(sPathFic, fileFilter:="Excel Files (*.xlsx), *.xlsx")
  Application.ScreenUpdating = False
  ' 1) Enregistrer avec les macros
  sFic = Replace(sFic, ".xlsx", ".xlsm")
  'ThisWorkbook.SaveAs Filename:=sFic, FileFormat:=xlOpenXMLWorkbookMacroEnabled
  ThisWorkbook.SaveCopyAs Filename:=sFic
  ' 2) Ouvrir le classeur ainsi sauvegardé
  Set Wbk = Workbooks.Open(sFic)
  ' 3) sauvergarder de nouveau le classeur sans macro
  sNewFic = Replace(sFic, ".xlsm", ".xlsx")
  Application.DisplayAlerts = False
  Wbk.SaveAs Filename:=sNewFic, FileFormat:=xlOpenXMLWorkbook
  ' Supprimer le fichier xlsm
  Kill sFic
  ' Et fermer le classeur modèle
  ThisWorkbook.Close SaveChanges:=False
  Application.DisplayAlerts = True
End Sub

@+

Re-bonjour Bruno,

Merci encore une fois du temps que consacre à me répondre.

La sauvegarde en .xlsx fonctionne. Cependant le code n'agit pas exactement comme je le voudrais je m'explique:

Sur le msgbox du début:

YES: Je save le classeur actuel en .XLSM (une backup en gros) -> donc utilisation de la macro de 3GB before save. Une fois la backup faite, j'execute le prog pour ensuite enregistrer en .xlsx avec ton code.

NO: Pas de backup et direct le code et la save XLSX

CANCEL: Exit sub

J'ai donc modifié ton code comme suit:

Option Explicit

Sub ExportExcel()
  Dim Sht As Worksheet, Wbk As Workbook
  Dim Img As Shape
  Dim sFic As String, sNewFic As String, sPathFic As String
  Dim Rep
  Rep = MsgBox("Vouslez-vous sauvegarder le classeur AVEC les macros avant l'export ?", vbQuestion + vbYesNoCancel + vbDefaultButton1, "")

  If Rep = vbNo Or Rep = vbYes Then
  If Rep = vbYes Then ThisWorkbook.Save
  ' Si réponse NON
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets(1).Delete
  For Each Sht In ThisWorkbook.Worksheets
    Sht.Activate
    If Range("R22") = True And Range("S22") = True And Range("T22") = True And Range("U22") = True Then
      Sht.Unprotect
      For Each Img In Sht.Shapes
        If Img.BottomRightCell.Row < 34 Then Img.Delete
      Next Img
      If Sht.Name <> "Dico" Then Range("R3:U34").Clear
      Sht.Delete
    Else
      Sht.Unprotect
      For Each Img In Sht.Shapes
        If Img.BottomRightCell.Row < 34 Then Img.Delete
      Next Img
      If Sht.Name <> "Dico" Then Range("R3:U34").Clear
    End If
    If Sht.Name = "Dico" Then Sht.Visible = False
  Next Sht
  Application.EnableEvents = True

  sPathFic = ThisWorkbook.Path & "\" & "Capabilité " & Range("A8")
  sFic = Application.GetSaveAsFilename(sPathFic, fileFilter:="Excel Files (*.xlsx), *.xlsx")
  Application.ScreenUpdating = False
  ' 1) Enregistrer avec les macros
  sFic = Replace(sFic, ".xlsx", ".xlsm")
  'ThisWorkbook.SaveAs Filename:=sFic, FileFormat:=xlOpenXMLWorkbookMacroEnabled
  ThisWorkbook.SaveCopyAs Filename:=sFic
  ' 2) Ouvrir le classeur ainsi sauvegardé
  Set Wbk = Workbooks.Open(sFic)
  ' 3) sauvergarder de nouveau le classeur sans macro
  sNewFic = Replace(sFic, ".xlsm", ".xlsx")
  Application.DisplayAlerts = False
  Wbk.SaveAs Filename:=sNewFic, FileFormat:=xlOpenXMLWorkbook
  ' Supprimer le fichier xlsm
  Kill sFic
  ' Et fermer le classeur modèle
  ThisWorkbook.Close SaveChanges:=False
  End If
  Application.DisplayAlerts = True
End Sub

Et la, c'est la tuile. J'ai un message d'erreur que je n'avais jamais vu avant:

Il semblerai que cette erreur survient lors du .delete d'une feuille

EDIT: ce msg d'erreur entraine la fermeture complète d'Excel

UP svp