XL 2010 probleme PDF

coue

XLDnaute Nouveau
Bonjour
J'ai un fichier qui date de 2013 qui imprimait des feuilles en PDF et dont la macro fonctionnait .Mais depuis 2018/2019 la macro ne fonctionne plus,est-ce une évolution du format PDF ou de la macro.
Pouvez-vous si vous avez le temps de regarder?
Si oui je vous enverrai le fichier.
Cordialement.
 

Staple1600

XLDnaute Barbatruc
Re

•>Magali GAS---D
Quelle macro dysfonctionne? (indique son nom)
Dans quel module ? (indique son nom)

Heureusement que j'avais précisé de poster le code de la macro ... :rolleyes:
(Cela aurait suffit)
Parce que c'est le dawa dans ton classeur!
 

coue

XLDnaute Nouveau
je t'envoie les codes qui ne fonctionnent pas
le premier est le choix feuille27 de la macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If Not Intersect(Target, Range("G3")) Is Nothing Then
If [TypeOrc] = "Type2" Then
Range("H3") = "Annexe3"
Else
If [TypeOrc] = "Type1" And [ChoixAnnexe] = "Annexe3" Then
Range("H3") = ""
End If
End If

End Sub
et la deuxième impression en pdf
Option Explicit

Const chemsave As String = "C:\ORC\"
Public Sub ImpressionFeuilleVir()
Dim PrinterDefault As String
Dim i As Integer
Dim nbRows As Integer
Dim nbColumns As Integer
Dim shp As Shape
Dim wshParalleles As Worksheet
Dim wshVirure As Worksheet
Dim usedRangeVirure As Range
Dim wshTempPrint As Worksheet
Dim rgParalleles As Range
Dim pdfjob As PDFCreator.clsPDFCreator
Dim Ret As Variant
Dim noErreur As Boolean
Dim tempRowStart As Integer


If [NbVir] = 0 Then
MsgBox "Pas de lignes sélectionnées !", vbExclamation, "Abandon"
Exit Sub
End If
'récup du nom de l'imprimante par défaut
PrinterDefault = Application.ActivePrinter

'chargement des variables objet feuilles
Set wshParalleles = Sheets("Feuilles_Paralleles")
Set wshVirure = Sheets("Vir")

'ajout d'une nouvelle feuille (copie de Virure)
wshVirure.Copy Before:=Sheets(7)
Set wshTempPrint = Sheets(7)
'si la feuille temp existe déjà alors on la supprime
On Error Resume Next
Application.DisplayAlerts = False
Sheets("x_tmp_PDF-export").Delete
Application.DisplayAlerts = True
On Error GoTo gest_err



wshTempPrint.Name = "x_tmp_PDF-export"

'On supprime, dans cette feuille temp, toutes les lignes utilisées et les images qu'elle contient
'(mais la largeur des colonnes est conservée)
wshTempPrint.Rows.Delete
For Each shp In wshTempPrint.Shapes
shp.Delete
Next

Set rgParalleles = wshParalleles.Range("G11:G18")

Application.Cursor = xlWait

'pour chaque OUI
For i = i + 1 To [NbVir]
'récup de la plage utile dans la feuille Virure
Set usedRangeVirure = wshVirure.Range(wshVirure.PageSetup.PrintArea)
nbRows = usedRangeVirure.Rows.Count
nbColumns = usedRangeVirure.Columns.Count
'copie des lignes de cette plage
wshVirure.Rows("1:" & nbRows).Copy
'collage des lignes dans la feuille temporaire

If wshTempPrint.UsedRange.Rows.Count = 1 Then
tempRowStart = 1
Else
tempRowStart = wshTempPrint.UsedRange.Rows.Count + 1
End If
wshTempPrint.Paste (wshTempPrint.Cells(tempRowStart, 1))
'copie-collage valeurs
wshVirure.Activate
Set usedRangeVir = wshVir.Range(Cells(1, 1), Cells(nbRows, nbColumns))
usedRangeVirure.Copy
wshTempPrint.Activate
wshTempPrint.Range(Cells(tempRowStart, 1), Cells(tempRowStart, 1)).Activate

On Error Resume Next
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = True
On Error GoTo gest_err

'passage de OUI à NON pour la ligne en cours
wshParalleles.Activate
rgParalleles.Select
Selection.Find(What:="OUI", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.FormulaR1C1 = "NON"
Next

'redéfinition de la zone d'impression
wshTempPrint.PageSetup.PrintArea = wshTempPrint.UsedRange.Address

'impression ou PDF de la feuille temporaire
If [TypeOrc] < "Type" Then
Application.Dialogs(xlDialogPrinterSetup).Show 'affiche fenetre choix imprimante
'impression
wshTempPrint.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False 'PrintPreview
Else
'instanciation de l'objet PDF Creator
Set pdfjob = New PDFCreator.clsPDFCreator

'paramètrage de PDF Creator
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Defaut de PDF Creator.", vbCritical + vbOKOnly, "PrtPDFCreator"
GoTo exit_sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave
.cOption("AutosaveFormat") = 0
.cPrinterStop = False
.cClearCache
End With


pdfjob.cOption("AutosaveFilename") = [NomPdf]


wshTempPrint.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator"

Do Until pdfjob.cCountOfPrintjobs > 0
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop

pdfjob.cClearCache

End If
noErreur = True
exit_sub:
On Error Resume Next
'on ferme les objets ouverts et on remet tout dans l'état initial
If Not pdfjob Is Nothing Then pdfjob.cClose
Set pdfjob = Nothing
Set wshParalleles = Nothing
Set wshVirure = Nothing
Set rgParalleles = Nothing
Application.ActivePrinter = PrinterDefault
Application.Cursor = xlDefault
wshParalleles.Activate
On Error GoTo 0
If noErreur Then _
MsgBox "Enregistrer Sous " & chemsave & [NomPdf]
Exit Sub

gest_err:
MsgBox Err.Description, vbCritical, "Erreur n° " & Err.Number
MsgBox "Impression annulée", vbExclamation, "Abandon"
Resume exit_sub
Resume

End Sub


Public Sub ImpressionFeuilleLong()
Dim PrinterDefault As String
Dim i As Integer
Dim nbRows As Integer
Dim nbColumns As Integer
Dim shp As Shape
Dim wshParalleles As Worksheet
Dim wshLongi As Worksheet
Dim usedRangeLongi As Range
Dim wshTempPrint As Worksheet
Dim rgParalleles As Range
Dim pdfjob As PDFCreator.clsPDFCreator
Dim Ret As Variant
Dim noErreur As Boolean
Dim tempRowStart As Integer


If [NbLong] = 0 Then
MsgBox "Pas de lignes sélectionnées !", vbExclamation, "Abandon"
Exit Sub
End If
'récup du nom de l'imprimante par défaut
PrinterDefault = Application.ActivePrinter

'chargement des variables objet feuilles
Set wshParalleles = Sheets("Feuilles_Paralleles")
Set wshLongi = Sheets("Longi")

'ajout d'une nouvelle feuille (copie de Longi)
wshLongi.Copy Before:=Sheets(7)
Set wshTempPrint = Sheets(7)
'si la feuille temp existe déjà alors on la supprime
On Error Resume Next
Application.DisplayAlerts = False
Sheets("x_tmp_PDF-export").Delete
Application.DisplayAlerts = True
On Error GoTo gest_err



wshTempPrint.Name = "x_tmp_PDF-export"

'On supprime, dans cette feuille temp, toutes les lignes utilisées et les images qu'elle contient
'(mais la largeur des colonnes est conservée)
wshTempPrint.Rows.Delete
For Each shp In wshTempPrint.Shapes
shp.Delete
Next

Set rgParalleles = wshParalleles.Range("M11:M52")

Application.Cursor = xlWait

'pour chaque OUI
For i = i + 1 To [NbLong]
'récup de la plage utile dans la feuille Longi
Set usedRangeLongi = wshLongi.Range(wshLongi.PageSetup.PrintArea)
nbRows = usedRangeLongi.Rows.Count
nbColumns = usedRangeLongi.Columns.Count
'copie des lignes de cette plage
wshLongi.Rows("1:" & nbRows).Copy
'collage des lignes dans la feuille temporaire

If wshTempPrint.UsedRange.Rows.Count = 1 Then
tempRowStart = 1
Else
tempRowStart = wshTempPrint.UsedRange.Rows.Count + 1
End If
wshTempPrint.Paste (wshTempPrint.Cells(tempRowStart, 1))
'copie-collage valeurs
wshLongi.Activate
Set usedRangeLongi = wshLong.Range(Cells(1, 1), Cells(nbRows, nbColumns))
usedRangeLongi.Copy
wshTempPrint.Activate
wshTempPrint.Range(Cells(tempRowStart, 1), Cells(tempRowStart, 1)).Activate

On Error Resume Next
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = True
On Error GoTo gest_err

'passage de OUI à NON pour la ligne en cours
wshParalleles.Activate
rgParalleles.Select
Selection.Find(What:="OUI", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.FormulaR1C1 = "NON"
Next

'redéfinition de la zone d'impression
wshTempPrint.PageSetup.PrintArea = wshTempPrint.UsedRange.Address

'impression ou PDF de la feuille temporaire
If [TypeOrc] < "Type" Then
Application.Dialogs(xlDialogPrinterSetup).Show 'affiche fenetre choix imprimante
'impression
wshTempPrint.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False 'PrintPreview
Else
'instanciation de l'objet PDF Creator
Set pdfjob = New PDFCreator.clsPDFCreator

'paramètrage de PDF Creator
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Defaut de PDF Creator.", vbCritical + vbOKOnly, "PrtPDFCreator"
GoTo exit_sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = chemsave
.cOption("AutosaveFormat") = 0
.cPrinterStop = False
.cClearCache
End With


pdfjob.cOption("AutosaveFilename") = [NomPdf]


wshTempPrint.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator"

Do Until pdfjob.cCountOfPrintjobs > 0
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop

pdfjob.cClearCache

End If
noErreur = True
exit_sub:
On Error Resume Next
'on ferme les objets ouverts et on remet tout dans l'état initial
If Not pdfjob Is Nothing Then pdfjob.cClose
Set pdfjob = Nothing
Set wshParalleles = Nothing
Set wshLongi = Nothing
Set rgParalleles = Nothing
Application.ActivePrinter = PrinterDefault
Application.Cursor = xlDefault
wshParalleles.Activate
On Error GoTo 0
If noErreur Then _
MsgBox "Enregistrer Sous " & chemsave & [NomPdf]
Exit Sub

gest_err:
MsgBox Err.Description, vbCritical, "Erreur n° " & Err.Number
MsgBox "Impression annulée", vbExclamation, "Abandon"
Resume exit_sub
Resume

End Sub







Sub OuiCir()
''
Range("A13").Select
ActiveCell.FormulaR1C1 = "OUI"
Selection.Copy
Range("A13:A52").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub

Sub NonCir()
''
Range("A13").Select
ActiveCell.FormulaR1C1 = "NON"
Selection.Copy
Range("A13:A52").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub
Sub OuiVir()
''
Range("G13").Select
ActiveCell.FormulaR1C1 = "OUI"
Selection.Copy
Range("G13:G18").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub

Sub NonVir()
''
Range("G13").Select
ActiveCell.FormulaR1C1 = "NON"
Selection.Copy
Range("G13:G18").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub
Sub OuiLong()
''
Range("M13").Select
ActiveCell.FormulaR1C1 = "OUI"
Selection.Copy
Range("M13:M52").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub

Sub NonLong()
''
Range("M13").Select
ActiveCell.FormulaR1C1 = "NON"
Selection.Copy
Range("M13:M52").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F4").Select
End Sub

Sub Onglets()
Sheets("Menu").Select
Dim i, j As Integer
Dim MENU(5 To 50, 1 To 1) As Variant
Dim FeuilleActive As String

i = 1

FeuilleActive = ActiveSheet.Name

For i = 1 To ThisWorkbook.Sheets.Count

If Sheets(i).Name <> "Menu" Then
Cells(i + 4, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name

' MENU(i + 4, 1) = Sheets(i).Name

End If
Next

'Sheets(FeuilleActive).Range("A5:A54") = MENU

End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Arrgggggghhhh!
Tu as posté tout le code
Il faut juste que l'on sache le nom de la procédure fautive
Une procédure c'est ce qu'il y entre Sub NomMacro() et End Sub

Et pour ce qui est de l'export PDF pourquoi tu passes encore par PDFCreator alors qu'Excel sait faire du PDF en natif désormais ?
 

coue

XLDnaute Nouveau
je ne le savais pas et comment on fait ,la première c'est le choix et pourtant tout fonctionner après c'est impression de toutes les feuilles ou seulement feuilles sélectionnées dans un répertoire et par pdf creator tout fonctionné.
je pense que s'est au début des vba que le problème existe
j'ai demandé à plusieurs personnes et pour l'instant pas solution
cordialement
 

coue

XLDnaute Nouveau
Bonjour
j'ai enlever la macro sélection type
mais quand je lance un choix de feuille j'ai la macro qui s'arrête à la ligne que j'ai mis en rouge
Option Explicit

Const chemsave As String = "C:\ORC\"
Public Sub ImpressionFeuilleVirure()
Dim PrinterDefault As String
Dim i As Integer
Dim nbRows As Integer
Dim nbColumns As Integer
Dim shp As Shape
Dim wshParalleles As Worksheet
Dim wshVirure As Worksheet
Dim usedRangeVirure As Range
Dim wshTempPrint As Worksheet
Dim rgParalleles As Range
Dim pdfjob As PDFCreator.clsPDFCreator

Cordialement
 

Staple1600

XLDnaute Barbatruc
Re

Encore une fois, depuis Excel 2007, plus besoin de PDFCreator
Excel peut enregistrer tout seul en VBA
Un petit exemple ci-dessous
VB:
Sub Export_simple_PDF()
Dim Chemin_PDF$
Chemin_PDF = ThisWorkbook.Path & "\"
Selection.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=Chemin_PDF & "Classeur1.pdf", _
          Quality:=xlQualityStandard
End Sub
Avec ce code, on obtient un PDF d'une plage de cellules sélectionnée sur une feuille.
Donc (ce n'est que mon avis), je te suggère d'utiliser simplement cette fonctionnalité désormais native d'Excel pour générer tes PDF.
 

coue

XLDnaute Nouveau
J'ai essayé elle fonctionne mais il faut que crée tous mes Feuilles circulaire,vir,longi car avant je choisissais par oui les feuilles en PDF et je voudrais l'enregistrer dans un répertoire.
Peut-on insérer la macro de sélection?
Cordialement
 

kiki29

XLDnaute Barbatruc
Salut, pour cela voir ici

Possibilité de fusion en 1 seul pdf de l'ensemble des feuilles, ou de génération des feuilles sélectionnées de façon séparée, de gestion des doublons via un indice, le tout dans un dossier créé automatiquement et nommé par défaut Dossier PDFs à la racine de l'application. L'ensemble des feuilles ( visibles ou pas ) est listé via le bouton Récap.
 

Pièces jointes

  • 1.png
    1.png
    31.5 KB · Affichages: 9
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, coue

•>coue
Je me suis replongé dans ton code
et je me permets cette suggestion de simplification
(pour alléger le code)
VB:
Sub Oui_Cir_Vir_Long()
Mettre_OUI Range("A13:A52,G13:G18,M13:M52")
End Sub
Sub Non_Cir_Vir_Long()
Mettre_OUI Range("A13:A52,G13:G18,M13:M52"), False
End Sub
Private Sub Mettre_OUI(Rng As Range, Optional Reponse As Boolean = True)
Rng.Value = IIf(Reponse, "OUI", "NON")
End Sub
Ce bout de code VBA peut remplacer les macros suivantes:
OuiCir, NonCir, OuiVir, NonVir, OuiLong et NonLong

Qu'en penses-tu ?
(Je te laisse tester chez toi [test OK chez moi])

EDITION: Bonjour kiki29
 

Staple1600

XLDnaute Barbatruc
Re

Je te l'ai indiqué dans le message#13
Staple¸ toujours en pyjama¸ confinement oblige à dit:
Ce bout de code VBA peut remplacer les macros suivantes:
OuiCir, NonCir, OuiVir, NonVir, OuiLong et NonLong
PS: Ce n'est qu'une suggestion pour alléger le code VBA
(avoir moins de lignes)
Ce n'est pas en rapport avec la problématique PDF.
 

Discussions similaires

Réponses
8
Affichages
348
Réponses
2
Affichages
253

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou