Problème Macro PDF

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

    1. 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. Bonjour,
        Eh bien je pense qu'il ne pourra pas car il a le message d'erreur 400 et 1004.
        1. 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. 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… ?

            1. Bonjour,
              Pouvez-vous me mettre une image de l'erreur...!
              1. Et voici l'erreur affichée sur Visual Basic:

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

              1. Le problème est que je ne sais pas sur quelle ligne est le problème.