Sauvegarder fichier Excel sous forme XPS Résolu/Fermé

Question

Bonjour,

Comme tout le monde je débute depuis peut en VBA et je souhaiterais sauvegarder le contenu modifiable de mon fichier Excel sous forme XPS  dans l'emplacement suivant: "C:\Users\Med\Pictures\" et les renommer avec le contenu de la cellule ("E11") qui va comporter des chiffres allant de 1 à l'infini 


mon problème est le suivent: 
Lorsque je change 1 dans la cellule ("E11") par 2
le clic sur le bouton, liée à la Macro destiner à la sauvegarde, le Nom de mon fichier XPS reste fixe sur 1

Votre aide sera très précieuse pour moi 
Si j'arrive a changer le contenu de la cellule  ("E11") et changer le Nom de ma sauvegarde en XPS de 1 à l'infini.


La Macro que j'essaye d'utiliser est la suivante: 


Sub Enregistrer_sousTEST()
'
' Enregistrer_sousTEST Macro
'

'
    ActiveWindow.SmallScroll Down:=-12
    Rows("18:18").Select
    ActiveWindow.FreezePanes = False
    ActiveWindow.SmallScroll Down:=-15
    Range("A1:E81").Select
    ActiveWindow.SmallScroll Down:=-33
    Range("H34").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("A1:E45").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("E11").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A3:E46").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypeXPS, Filename:= _
        "C:\Users\Med\Pictures\1.xps", Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub


Merci d'avance

Cordialement

achgel

cs_Le Pivert · Answer

Bonjour,

comme ceci avec une variable: 

Sub Enregistrer_sousTEST()
Dim nom As String
ActiveWindow.SmallScroll Down:=-12
Rows("18:18").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-15
Range("A1:E81").Select
ActiveWindow.SmallScroll Down:=-33
Range("H34").Select
ActiveWindow.SmallScroll Down:=-30
Range("A1:E45").Select
ActiveWindow.SmallScroll Down:=-9
nom = Range("E11").Value
Range("A3:E46").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypeXPS, Filename:= _
"C:\Users\Med\Pictures\" & nom & ".xps", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub


évite le Select. Tu peux remplacer:

Range("H34").Select
ActiveWindow.SmallScroll Down:=-30

par

Range("H34").ActiveWindow.SmallScroll Down:=-30


 etc. pour les autres

cs_Le Pivert · Answer

Si le fichier est enregistré dans le même dossier , une alerte le signale automatiquement.
Par contre si ce n'est pas dans le même dossier et que tu ne veux pas 2 fichiers ayant le même nom, voici une petite macro à mettre dans la feuille où se trouve la cellule de saisie du nom du fichier: 

Option Explicit
Dim nom As String
Dim DerLig As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("E11")) Is Nothing Then
nom = Target.Value
DerLig = Range("A65535").End(xlUp).Row
doublons
End If
End Sub
Private Sub doublons()
Dim c As Range
For Each c In Range("A2", "A" & DerLig)
    If c.Value = nom Then
      nom = ""
     MsgBox "Le nom de ce fichier existe, veuillez le changer!"
     Else
       Range("A" & DerLig + 1) = nom
    End If
    Next c
End Sub

cs_Le Pivert · Answer

Voilà un exemple a adapter:

http://www.cjoint.com/c/EKwr7SNDwNQ

cs_Le Pivert · Answer

Voilà beaucoup plus simple:

Option Explicit
Dim nom, sNomFichierXPS, chemin, NomFich As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("E11")) Is Nothing Then
nom = Target.Value
End If
End Sub
Sub Enregistrer_sousTEST()
chemin = Range("E1").Value
ActiveWindow.SmallScroll Down:=-12
Rows("18:18").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-15
Range("A1:E81").Select
ActiveWindow.SmallScroll Down:=-33
Range("H34").Select
ActiveWindow.SmallScroll Down:=-30
Range("A1:E45").Select
ActiveWindow.SmallScroll Down:=-9
nom = Range("E11").Value
If nom = "" Or chemin = "" Then Exit Sub
Range("A3:E46").Select
sNomFichierXPS = chemin & nom & ".xps"
NomFich = Dir(sNomFichierXPS)
If NomFich <> "" Then
MsgBox "LeFichier Existe"
Exit Sub
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypeXPS, Filename:=sNomFichierXPS _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "Votre XPS " & nom & "  est enregistré."
End If
End Sub

cs_Le Pivert · Answer

Voilà prêt à l'emploi:


 http://www.cjoint.com/c/EKyhewFNPbQ

Sauvegarder fichier Excel sous forme XPS

5 réponses

Discussions similaires