Problème Macro PDF Fermé

Question

Bonjour,

Depuis le changement de mon EXCEL (2010 => 2016), la macro de mon fichier excel ne fonctionne plus.
Cette dernière avait pour but de mettre en PDF, 5 onglets de mon fichier EXCEL.

Aujourd'hui quand je l'actionne, elle m'affiche "erreur 400". Pouvez vous m'aider sur ce sujet s'il vous plaît.

Voici la Macro:

Sub Exporter_PDF()

On Error Resume Next
ChDir ("C:\" & Environ("username") & "\Desktop\Tableau_de_bord\")
If Err Then MkDir ("C:\" & Environ("username") & "\Desktop\Tableau_de_bord\") 'pour le créer
On Error GoTo 0

    Sheets(Array("8 principaux indicateurs", "Focus livs, qualite & VO", "Visuel", "8 principaux indicateurs N-1", "MARQUE")). _
        Select
     Sheets("8 principaux indicateurs").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\" & Environ("username") & "\Desktop\Tableau_de_bord\" & Worksheets("8 principaux indicateurs").Range("B8") & " " & Range("D4") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub


Merci par avance.

Le Pingou · Answer

Bonjour,
Merci de préciser la ligne concernée (surlignée en jaune)!

Le Pingou · Answer

Bonjour,
Pouvez-vous me mettre une image de l'erreur...!

Matt-94 · Answer

Voici l'erreur que Excel m'affiche:

Le Pingou · Answer

Bonjour,
Vous me montrez 2 erreurs (400 et 1004) …. !
Je vous propose d’essayer ceci :
Sous VBA vous insérez un nouveau module et ensuite vous copier/coller votre code.
Supprimer ensuite l’ancien module, enregistrer fermer votre classeur et le rouvrir puis lancer votre code… ?

yg_be · Answer

bonjour, 
rien d'autre n'a changé, à part la version de Excel?
peut-être un soucis avec le répertoire ou le nom du fichier.
si tu exécutes ceci, peux-tu vérifier que le dossier existe et que tu peux y créer un fichier de ce nom?
dim nomfichier as string
nomfichier= "C:\" & Environ("username") & "\Desktop\Tableau_de_bord\" _
      & Worksheets("8 principaux indicateurs").Range("B8") & " " & Range("D4") & ".pdf"
msgbox nomfichier

Le Pingou · Answer

Bonjour,
Eh bien je pense qu'il ne pourra pas car il a le message d'erreur 400 et 1004.

cs_Le Pivert · Answer

Bonjour à tous,

il faut chercher le chemin du bureau comme ceci:

https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/ 

ce qui donne:

Option Explicit
Dim nomdossier As String
Dim dossier As String
Dim bureau As String
Dim nom As String
Sub Exporter_PDF()
nomdossier = "Tableau_de_bord" 'a adapter nom dossier
cheminbureau
TesteSiDossierExiste
dossier = bureau & "\" & nomdossier & "\"
nom = Sheets("Feuil1").Range("B8") & " " & Range("D4") & ".pdf" ' a adapter nom feuille
Sheets(Array("Feuil1", "Feuil3", "Feuil5", "Feuil7")).Select 'a adapter nom des feuilles
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & nom, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
        MsgBox "Opération réussie", vbInformation, "Enregistrement sur Bureau en pdf"
End Sub
Sub TesteSiDossierExiste()
'https://excel-malin.com/codes-sources-vba/vba-verifier-si-dossier-existe/
Dim MonDossier As String

MonDossier = bureau & "\" & nomdossier

If DossierExiste(MonDossier) = True Then
       ' MsgBox "Le dossier existe..."
    Else
      MkDir (bureau & "\" & nomdossier)
    End If

End Sub
Public Function DossierExiste(MonDossier As String)
'par Excel-Malin.com ( http://excel-malin.com )

If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function
Private Sub cheminbureau()
'https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

On Error GoTo TestErreur
    Dim cheminbureau As String
    
    cheminbureau = ObtenirCheminBureau()
    
    bureau = cheminbureau 'affiche le chemin vers le dossier Bureau
    Exit Sub
TestErreur:
    MsgBox "Une erreur s'est produite..."
End Sub
Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo ObtenirCheminBureauError
    Dim cheminbureau As String
    cheminbureau = ""
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    
    cheminbureau = oWSHShell.SpecialFolders("Desktop")
    
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = cheminbureau

Exit Function
ObtenirCheminBureauError:
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = ""
End Function

voilà

Le Pingou · Answer

Bonjour cs_Le Pivert ,
Je vous rappel que la demande est celle-ci :
Depuis le changement de mon EXCEL (2010 => 2016), la macro de mon fichier excel ne fonctionne plus.

Donc son code fonctionnait très bien avant mise à jour et en plus je l'ai testé chez moi et il fonctionne sans problème.

Il faudrait qu'il essaye la solution du poste 8.