Enregistrer sous en XLSX

[redba90]

Bonjour
j'ai un code qui fonctionne bien pour enregistrer en PDF, je voudrais faire la même mais en enregistrant mon fichier xlsm en xlsx

Sub SauverEnPDF()

Dim vararray() As String 
Dim csname As Integer 
Dim c As Integer 
Dim countarr As Integer
Dim r As Integer 
Dim sname As Worksheet 
Dim strFileName As String

   csname = Range("K2").Column
   c = Range("L2").Column
   Set sname = ActiveSheet
   r = Range("L2").Row
   countarr = 0

   While sname.Cells(r, csname) <> ""
      If sname.Cells(r, c) = 1 Then
         ReDim Preserve vararray(countarr)
         
         vararray(countarr) = sname.Cells(r, csname).Value
         countarr = countarr + 1
      End If
   r = r + 1
   Wend

   Sheets(vararray).Select

   strFileName = Application.GetSaveAsFilename(Filefilter:="PDF Files (*.pdf), *.pdf", Title:="Entrez le nom du fichier")

   If strFileName <> "False" And strFileName <> "Faux" Then

      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName _
       , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
       :=False, OpenAfterPublish:=False

   End If

   sname.Select

   Set sname = Nothing

End Sub

Merci pour votre aide

 

[danielco]

Bonjour,

Est-ce que tu veux enregistrer le fichier complet ou seulement certaines feuilles ?

Cordialement.

Daniel

 

[redba90]

Bonjour,
Que certaines feuilles, le code que j'ai posté le fait en PDF en fonctionnant avec des 0 pour celles que je ne veux pas et les autres 1

 

[danielco]

Ajoute (non testé) :

   Sheets(vararray).Copy
   ActiveSheet.SaveAs ThisWorkbook.Path & "\" & "abcdef.xlsx", xlOpenXMLWorkbook
   ActiveWorkbook.Close

Après :

   If strFileName <> "False" And strFileName <> "Faux" Then

      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName _
       , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
       :=False, OpenAfterPublish:=False

   End If

Le fichier s'appelle "abcdef.xlsx" dans le même dossier que le fichier existant.

Daniel

 

[redba90]

Bonjour Daniel

Ton code fonctionne parfaitement! est il possible de faire apparaître la boite Application.GetSaveAsFilename?
Pour choisir un nom et l'emplacement du fichier.

 

[redba90]

Bonjour Daniel

Ton code fonctionne parfaitement! est il possible de faire apparaître la boite Application.GetSaveAsFilename?
Pour choisir un nom et l'emplacement du fichier.

C'est bon j'ai juste modifié ton code par:

      Sheets(vararray).Copy
   Application.Dialogs(xlDialogSaveAs).Show
   ActiveWorkbook.Close

Merci pour ton aide problème résolu!