Imprimer sous forme d'image depuis VBA

Le
Fredo(67)
Bonjour,

Je souhaiterai pouvoir automatiser l'impression d'une plage de cellule Exce=
l sous forme d'image.

Pour l'instant j'utilise PDf Créator et je paramètre le type de d=
oc demandé.
Cela donne une belle qualité, mais l'action est fastidieuse.

Les prodédures que j'ai trouvé avec VBA font une copie d'écr=
an, puis collent dans un graph.. cela donne une qualité vraiment mo=
yenne.

N'y a t'il pas une procédure auto qui donne de bons résultats (qu=
alités)

MErci pour vos lumières
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Michd
Le #26486616
Bonjour,
J'ai en magasin une procédure que tu devras modifier selon tes besoins. Cela fait un bon moment que
le l'ait écrite... je n'ai plus PdfCreator, par conséquent, je ne peux la tester! La procédure peut
imprimer un fichier PDF ou une version Papier. Le nom des imprimantes et leur port à déterminer.
Quelle version Excel as-tu?
'----------------------------------------------
Sub Test()
Dim Ok As Boolean, x As Variant
Dim RepertoireParDefautPDF As String
With Worksheets("Feuil1") ' Nom à adapter
.Unprotect "483"
.Range("31:40").EntireRow.Hidden = False
.PageSetup.PrintArea = .Range("$B$1:$J$41").Address
'*****************************************
'à déterminer -> où tu veux enregistrer tes PDF
RepertoireParDefautPDF = "c:Atravail"
Do
x = Application.InputBox(Prompt:= _
"Inscrivez le nom que " & vbCrLf & _
"vous voulez donner à votre votre " & _
"fichier PDF.", Title:="Nom du fichier pdf", _
Type:=3)
If Format(x) = False Or x = "" Then
If MsgBox("Désirez-vous annuler la " & _
"création du fichier PDF?", vbCritical + _
vbYesNo, "Attention") = vbYes Then
Ok = True
End If
Else
Ok = True
End If
Loop Until Ok = True
'Vérifier si l'usager à inscrit
'l'extension ".pdf" au nom saisi
If LCase(Right(x, 4)) <> ".pdf" Then
x = x & ".pdf"
End If
.PrintOut copies:=1, _
ActivePrinter:="PDFCreator sur Ne00:", _
PrToFileName:=RepertoireParDefautPDF & x
'*****************************************
'Impression sur papier
.PrintOut copies:=1, ActivePrinter:= _
"\FR7411AP1FR7411ALIM01 sur Ne02:"
'suppression de la plage PrintArea
.PageSetup.PrintArea = ""
.Range("31:40").EntireRow.Hidden = True
.Protect "483"
End With
End Sub
'----------------------------------------------
MichD
Fredo(67)
Le #26486615
Le lundi 27 août 2018 14:09:01 UTC+2, Michd a écrit :
Bonjour,
J'ai en magasin une procédure que tu devras modifier selon tes besoi ns. Cela fait un bon moment que
le l'ait écrite... je n'ai plus PdfCreator, par conséquent, je ne peux la tester! La procédure peut
imprimer un fichier PDF ou une version Papier. Le nom des imprimantes et leur port à déterminer.
Quelle version Excel as-tu?
'----------------------------------------------
Sub Test()
Dim Ok As Boolean, x As Variant
Dim RepertoireParDefautPDF As String
With Worksheets("Feuil1") ' Nom à adapter
.Unprotect "483"
.Range("31:40").EntireRow.Hidden = False
.PageSetup.PrintArea = .Range("$B$1:$J$41").Address
'*****************************************
'à déterminer -> où tu veux enregistrer tes PDF
RepertoireParDefautPDF = "c:Atravail"
Do
x = Application.InputBox(Prompt:= _
"Inscrivez le nom que " & vbCrLf & _
"vous voulez donner à votre votre " & _
"fichier PDF.", Title:="Nom du fichier pdf", _
Type:=3)
If Format(x) = False Or x = "" Then
If MsgBox("Désirez-vous annuler la " & _
"création du fichier PDF?", vbCritical + _
vbYesNo, "Attention") = vbYes Then
Ok = True
End If
Else
Ok = True
End If
Loop Until Ok = True
'Vérifier si l'usager à inscrit
'l'extension ".pdf" au nom saisi
If LCase(Right(x, 4)) <> ".pdf" Then
x = x & ".pdf"
End If
.PrintOut copies:=1, _
ActivePrinter:="PDFCreator sur Ne00:", _
PrToFileName:=RepertoireParDefautPDF & x
'*****************************************
'Impression sur papier
.PrintOut copies:=1, ActivePrinter:= _
"\FR7411AP1FR7411ALIM01 sur Ne02:"
'suppression de la plage PrintArea
.PageSetup.PrintArea = ""
.Range("31:40").EntireRow.Hidden = True
.Protect "483"
End With
End Sub
'----------------------------------------------
MichD

Bonjour MichD
J'ai Excel 2016.
Michd
Le #26486618
Bonjour,
Avec Excel 2016, nul besoin d'utiliser PdfCreator pour créer un fichier PDF d'une plage de cellules.
Essaie ceci :
Feuil1.Range("A1:A10").ExportAsFixedFormat xlTypePDF, "c:usersMichddocuments_AMichD.pdf"
Et pour répondre à ton message que tu m'as envoyé directement dans mon courriel, Si tu ne peux
utiliser directement la valeur de la propriété "Name" d'un objet Worksheet, es-tu certain que le nom
utilisé dans ton code existe vraiment?
MichD
Fredo(67)
Le #26486619
Le lundi 27 août 2018 14:30:18 UTC+2, Michd a écrit :
Bonjour,
Avec Excel 2016, nul besoin d'utiliser PdfCreator pour créer un fich ier PDF d'une plage de cellules.
Essaie ceci :
Feuil1.Range("A1:A10").ExportAsFixedFormat xlTypePDF, "c:usersMichddoc uments_AMichD.pdf"
Et pour répondre à ton message que tu m'as envoyé directem ent dans mon courriel, Si tu ne peux
utiliser directement la valeur de la propriété "Name" d'un obje t Worksheet, es-tu certain que le nom
utilisé dans ton code existe vraiment?
MichD

J'ai du mal m'exprimer,
je cherche à faire un JPG de ma zone (pour créer une image qui se ra ultètieurement publiée su rFacebook)
Michd
Le #26486626
| je cherche à faire un JPG de ma zone (pour créer une image qui sera ultètieurement publiée su
rFacebook). Les prodédures que j'ai trouvé avec VBA font une copie d'écran, puis collent dans un
graph..... cela donne une qualité vraiment moyenne....
**** Avec Excel, c'est la seule méthode que je connaisse. Manuellement, tu as essayé la "capture
d'écran" à l'aide de l'outil de Windows?
MichD
Fredo(67)
Le #26486625
Y'a t'il moyen de commander PAINT depuis Excel ?
On pourrait alors avoir une copie dans paint puis un enregistrer sous....
La procédure manuelle semble donner de meilleurs résultats graphi ques...
Michd
Le #26486630
À cette adresse, tu as au moins 2 procédures qui devraient t'intéresser pour l'usage de "Paint" avec
Excel-VBA. Pas tester personnellement.
https://www.excel-downloads.com/threads/vba-export-excel-vers-image-sous-mspaint.171362/
MichD
Publicité
Poster une réponse
Anonyme