Problème Macro PDF

Matt-94 -  
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.

8 réponses

  • Votes
  • Date
  • Date décroissante
  1. Le Pingou
    Bonjour,
    Merci de préciser la ligne concernée (surlignée en jaune)!

    1. Matt-94 Auteur
      Le problème est que je ne sais pas sur quelle ligne est le problème.
  2. Le Pingou
    Bonjour,
    Pouvez-vous me mettre une image de l'erreur...!
    1. Matt-94 Auteur
      Et voici l'erreur affichée sur Visual Basic:

  4. Le Pingou
    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… ?

    2. yg_be Contributeur
      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
      1. Le Pingou
        Bonjour,
        Eh bien je pense qu'il ne pourra pas car il a le message d'erreur 400 et 1004.
        1. cs_Le Pivert Contributeur
          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à
          1. Le Pingou
            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.