enregistrer en pdf un apercu d'impression

[teamtat]

Bonjour,
Voila mon probleme,j'ai un programme sur excel qui en fonction des paramétres saisie crée des page en mode apercu d'impression
J'arrive sans souci a enregistrer en pdf mais sa enregistre ma feuille de saisie et non ma feuille crée, comment faire ? je vous met le code de ma macro
Merci

ub Impression_INV()
Dim ShPageGarde As Worksheet
Dim CptLigne As Integer
Dim Supprimer As Boolean

ThisWorkbook.Unprotect Mdp
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets(shtPageGarde).Delete
Application.DisplayAlerts = False
On Error GoTo 0

Sheets(shtPageGardeModele).Copy after:=Sheets(Sheets.Count)
Sheets(shtPageGardeModele & " (2)").Name = shtPageGarde

With Sheets(shtPageGarde)
For CptLigne = 99 To 47 Step -1
If IsError(.Range("A" & CptLigne).Value) Then
Supprimer = True
ElseIf .Range("A" & CptLigne).Value = 0 Or .Range("A" & CptLigne).Value = "" Then
Supprimer = True
Else
Supprimer = False
End If

If Supprimer Then
.Rows(CptLigne).Delete
End If
Next CptLigne

ActiveWindow.View = xlNormalView
.Cells.PageBreak = xlPageBreakNone

.Visible = xlSheetVisible
.PrintOut Preview:=True
.Visible = xlSheetHidden
End With
Application.ScreenUpdating = True
ThisWorkbook.Protect Mdp, False, True
End Sub

 

[teamtat]

Re : enregistrer en pdf un apercu d'impression

Voila le code que j'utilise pour convertir en PDF

Sub Edition_PdF()
'
' Edition_PdF Macro
' Macro enregistrée le 13/10/2009 par gilloots
'
'
Columns("N:AE").Select
Range("N2").Activate
Selection.EntireColumn.Hidden = True

Application.ActivePrinter = "PDFCreator sur Ne00:"


ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne01:", Collate:=True


Columns("N:AE").Select
Range("N2").Activate
Selection.EntireColumn.Hidden = False

'

End Sub

Sub Impression_PDF()


Dim no_app As String
Dim design As String
Dim nom As String
Dim n As Integer



ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=Imprimante_AdobePDF, Collate:=True

Application.OnTime Now + TimeValue("00:00:03"), "Attente"

End Sub
Sub Attente()



Dim nom As String


nom = Range("S4").Value & "_" & Range("T4").Value

SendKeys ("{ENTER}"), [ True]
SendKeys (nom), [ True]

Application.OnTime Now + TimeValue("00:00:03"), "AttenteBis"

End Sub
Sub AttenteBis()
Dim date_propo As String
Dim no_app As String
Dim rep As String
Dim nom As String

nom = Range("S4").Value & "_" & Range("T4").Value
rep = "Y:\TKAF\R01\A427\_Commun-Agence\GENERAL\Outils de Suivi SAV-Modernisation\Suivi clients\Pas de calais Habitat\" & nom
SendKeys (rep), [ True]
SendKeys ("{ENTER}"), [ True]

End Sub




Private Function Imprimante_AdobePDF() As String

Dim i As Integer
Dim NomPortReseau As String

For i = 0 To 99
If i < 10 Then
NomPortReseau = "PDFCreator sur Ne0" & i & ":"
Else
NomPortReseau = "PDFCreator sur Ne" & i & ":"
End If

On Error Resume Next

Application.ActivePrinter = NomPortReseau

If ActivePrinter = NomPortReseau Then
Exit For
End If
Next i

Imprimante_AdobePDF = NomPortReseau

End Function

 

[Compte Supprimé 979]

Re : enregistrer en pdf un apercu d'impression

Bonsoir Teamtat,

Merci d'utiliser les balises [ code] et [ /code] (sans le 1er espace après le crochet)

A+

 

[teamtat]

Re : enregistrer en pdf un apercu d'impression

Bonjour,
Voila mon probleme,j'ai un programme sur excel qui en fonction des paramétres saisie crée des page en mode apercu d'impression
J'arrive sans souci a enregistrer en pdf mais sa enregistre ma feuille de saisie et non ma feuille crée, comment faire ? je vous met le code de ma macro
Merci

 Sub Impression_INV()
Dim ShPageGarde As Worksheet
Dim CptLigne As Integer
Dim Supprimer As Boolean

ThisWorkbook.Unprotect Mdp
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets(shtPageGarde).Delete
Application.DisplayAlerts = False
On Error GoTo 0

Sheets(shtPageGardeModele).Copy after:=Sheets(Sheets.Count)
Sheets(shtPageGardeModele & " (2)").Name = shtPageGarde

With Sheets(shtPageGarde)
For CptLigne = 99 To 47 Step -1
If IsError(.Range("A" & CptLigne).Value) Then
Supprimer = True
ElseIf .Range("A" & CptLigne).Value = 0 Or .Range("A" & CptLigne).Value = "" Then
Supprimer = True
Else
Supprimer = False
End If

If Supprimer Then
.Rows(CptLigne).Delete
End If
Next CptLigne

ActiveWindow.View = xlNormalView
.Cells.PageBreak = xlPageBreakNone

.Visible = xlSheetVisible
.PrintOut Preview:=True
.Visible = xlSheetHidden
End With
Application.ScreenUpdating = True
ThisWorkbook.Protect Mdp, False, True
End Sub

 

[teamtat]

Re : enregistrer en pdf un apercu d'impression

 Sub Edition_PdF()
'

Columns("N:AE").Select
Range("N2").Activate
Selection.EntireColumn.Hidden = True

Application.ActivePrinter = "PDFCreator sur Ne00:"


ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne01:", Collate:=True


Columns("N:AE").Select
Range("N2").Activate
Selection.EntireColumn.Hidden = False

'

End Sub

Sub Impression_PDF()


Dim no_app As String
Dim design As String
Dim nom As String
Dim n As Integer



ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=Imprimante_AdobePDF, Collate:=True

Application.OnTime Now + TimeValue("00:00:03"), "Attente"

End Sub
Sub Attente()



Dim nom As String


nom = Range("S4").Value & "_" & Range("T4").Value

SendKeys ("{ENTER}"), [ True]
SendKeys (nom), [ True]

Application.OnTime Now + TimeValue("00:00:03"), "AttenteBis"

End Sub
Sub AttenteBis()
Dim date_propo As String
Dim no_app As String
Dim rep As String
Dim nom As String

nom = Range("S4").Value & "_" & Range("T4").Value
rep = "Y:\TKAF\R01\A427\_Commun-Agence\GENERAL\Outils de Suivi SAV-Modernisation\Suivi clients\Pas de calais Habitat\" & nom
SendKeys (rep), [ True]
SendKeys ("{ENTER}"), [ True]

End Sub




Private Function Imprimante_AdobePDF() As String

Dim i As Integer
Dim NomPortReseau As String

For i = 0 To 99
If i < 10 Then
NomPortReseau = "PDFCreator sur Ne0" & i & ":"
Else
NomPortReseau = "PDFCreator sur Ne" & i & ":"
End If

On Error Resume Next

Application.ActivePrinter = NomPortReseau

If ActivePrinter = NomPortReseau Then
Exit For
End If
Next i

Imprimante_AdobePDF = NomPortReseau

End Function