Sauvegarder fichier Excel sous forme XPS

Résolu

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention -
achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention - 25 nov. 2015 à 23:29

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

Afficher la suite

A voir également:

Sauvegarder fichier Excel sous forme XPS
Fichier bin - Guide
Mise en forme conditionnelle excel - Guide
Fichier epub - Guide
Fichier rar - Guide
Comment réduire la taille d'un fichier - Guide

5 réponses

Réponse 1 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Voilà prêt à l'emploi:

http://www.cjoint.com/c/EKyhewFNPbQ

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention 1

Bonsoir Le Pivert
j'ai utilisé uniquement la Macro lié à l'UserForm, puisque j'ai eu le même résultat
et VOTRE APPLICATION, pour ne pas dire mon application, fonctionne parfaitement bien

C'était vraiment très gentille de votre part
Merci infiniment

Réponse 2 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention 1

Mille

Merci cs_Le Pivert

Grace à votre aide j'arrive maintenant à sauvegarder mes données Excel en XPS.

Est la Macro fonctionne parfaitement bien.

Juste pour vous informer, et pour éviter le Select.

J'ai remplacé

Range("H34").Select
ActiveWindow.SmallScroll Down:=-30

Par

Range("H34").ActiveWindow.SmallScroll Down:=-30

Et les autres aussi

Mais la sauvegarde n'a pas abouti

Cordialement

achgel

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention 1

Bonsoir

Est ce qu'il y'a un moyen pour que la Macro me donne un message signalant que le nom du ficher xps que j'essaye de sauvegarder existe déjà.
Puisque tout le monde pourra se tremper en saisissant un nom déjà existant

Merci d'avance

Réponse 3 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention 1

Bonjour Le Pivert

J'ai copier la Macro dans la feuille où se trouve la cellule de saisie du nom du fichier, mais le fichier s'en registre dans l'emplacement prévu ("C:\Users\Med\Pictures\) avec un le Nom déjà existant avec les nouvelles données, et bien sur je perd les anciennes données.

Je compte beaucoup sur votre aide

Merci infiniment

Cordialement

Réponse 4 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Voilà un exemple a adapter:

http://www.cjoint.com/c/EKwr7SNDwNQ

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

achgel Messages postés 108 Date d'inscription Statut Membre Dernière intervention 1

Merci Le Pivert

C'est bien ce que je cherchais

Mais j'ai encore deux petits soucies:

Le premier c'est que le Nom de la cellule "E11" apparaît en Double, comme nom du fichier .xps

Le deuxième c'est que je veux sauvegarder mes fichiers .xps dans l'emplacement suivent:

C:\Users\Med\Pictures\Result\Exm

Je vous souhaite de passer une excellente soirée.

Et merci infiniment

Cordialement

Votre réponse