VBA chemin enregistrement

Le 01/06/2016 à 15:20

Bonjour, :

Je vous pose mon problème après plusieurs recherche et je n'ai toujours pas trouvé la solution je ne pense pas être très loin de la solution.

Je souhaite enregistrer la feuille active de mon ficher en PDF selon un nom donné par rapport à des cellules dans cette feuille.

Cette partie j'y suis arrivé avec ce code :

Sub Enregistrer_pdf()

Chemin = "Z:\PERSONNEL\"

texte = Range("='Logistique et industrie'!$B$4") & " - " & Range("='Logistique et industrie'!$B$30") & " - " & Range("='Logistique et industrie'!$B$8")

Application.DisplayAlerts = False

ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _

Filename:=Chemin & texte, _

Quality:=x1QualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

End Sub

Plustôt facilement.

Maintenant j'aimerais pouvoir mettre une condition à cette enregistrement en fonction d'une cellule ce qui permetterais de mettre le ficher PDF dans le bon dossier.

L'erreur que j'obtiens est "End If sans bloc IF" alors que j'ai les bloc IF

Voila le code que j'ai écrit: (j'ai vérifié l'orthographe; et les dossiers; ainsi que les droit admin.)

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin As String

If (Cells(B6)) = "Agencement" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Agencement"

End If

If (Cells(B6)) = "Guidage" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Guidage"

End If

If (Cells(B6)) = "Chariot" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Chariot"

End If

If (Cells(B6)) = "Panier" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Panier"

End If

Fichier = Range("='Logistique et industrie'!$B$4") & " - " & Range("='Logistique et industrie'!$B$30") & " - " & Range("='Logistique et industrie'!$B$8")

Application.DisplayAlerts = False

ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _

Filename:=Chemin & Fichier, _

Quality:=x1QualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

End Sub

Merci d'avance !

Cordialement lybelo

Le 01/06/2016 à 15:44

Bonjour,

Il faut enlever tous les "End If". D'ailleurs il n'y a pas que ça comme erreurs.

Le 01/06/2016 à 15:45

bonjour

comme ceci je penses, soit il y a une seule instruction après le then et donc c'est sur la meme ligne et donc pas besoin de end if ensuite soit on met ce qu'il y a après le then a la ligne et on garde le endif

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin As String
If (Cells(B6)) = "Agencement" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Agencement"
If (Cells(B6)) = "Guidage" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Guidage"
If (Cells(B6)) = "Chariot" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Chariot"
If (Cells(B6)) = "Panier" Then Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Panier"
Fichier = Range("='Logistique et industrie'!$B$4") & " - " & Range("='Logistique et industrie'!$B$30") & " - " & Range("='Logistique et industrie'!$B$8")
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _
Filename:=Chemin & Fichier, _
Quality:=x1QualityMinimum, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End Sub

EDIT : Bonjour Raja, le reste du code j'ai pas regardé...

Le 01/06/2016 à 16:20

Merci.

raja et Fred.

J'ai testé sans les End If et je n'ai plus l'erreur.

Mais j'ai une nouvelle erreur qui est "erreur définis par l'application ou par l'objet"

Ps: j'ai testé également en appelant la variable chemin après comme ci dessous :

Sub test2()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin As String

If (Cells(B6)) = "Agencement" Then

Application.DisplayAlerts = False

Chemin = "Z:\PERSONNEL\SUIVI ECHANTILLONS\Agencement"

ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _

Filename:=Chemin & Fichier, _

Quality:=x1QualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

End If

j'ai également essayer avec Range a la place de Cells mais cela ne fonctionne pas non plus je test d'autres chose demain encore.

Si d'ici la quelqu'un a des solutions je suis preneur.

Le 01/06/2016 à 17:45

Re,

If (Cells(B6)) = "Agencement" Then

s'écrit comme ça :

If Range("B6") = "Agencement" Then

ou comme ça

If Cells(6,2) = "Agencement" Then

Le 09/06/2016 à 10:06

Re,

J'ai finalement réussi a faire fonctionné l'enregistrement de cette feuille en format PDF sur le Serveur.

Avec sa:

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin, produit As String

produit = ActiveSheet.Range("B6").Value

nom_Fichier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")
Fichier = nom_Fichier & ".pdf"
Application.DisplayAlerts = False

Call SetUNCPath("\\commercial\SUIVI ECHANTILLONS\" & produit & Dossier & "\")

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub

Mais maintenant j'aimerais créer un dossier avant de créer ce Pdf.

ce dossier aurait le même nom que le pdf, ce qui va donc changer le chemin du pdf pour qu'il se place dans bon dossier et sous dossier du même nom.

J'ai tester comme cela mais cela no fonctionne pas.

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin, produit As String

Dossier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")
produit = ActiveSheet.Range("B6").Value
ChDir ("\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & "\")
MkDir ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")

nom_Fichier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")
Fichier = nom_Fichier & ".pdf"
Application.DisplayAlerts = False

Call SetUNCPath("\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & Dossier & "\")

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub

Dites moi si vous voulez absolument le fichier pour voir ou si mon post suffit

Cordialement lybelo.

Le 15/06/2016 à 09:07

petit Up

Le 16/06/2016 à 09:10

Bonjour,

J'ai changé la macro maintenant le dossier ce crée correctement mais, au niveau de la macro test pour enregistrer en PDF j'ai une erreur au niveau du chemin que je n'arrive a solutionner. " incompatibilité de type"

Sub dodo()

Dim Dossier As String, produit As String
produit = ActiveSheet.Range("B6").Value
Dossier = (ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8"))
MkDir ("\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & "\")

End Sub

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin, produit As String

produit = ActiveSheet.Range("B6").Value

nom_fichier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")
Fichier = nom_fichier & ".pdf"
Application.DisplayAlerts = False

Call SetUNCPath("\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit \"& nom_ficher)

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub

Le 16/06/2016 à 09:27

Bonjour

sans avoir de fichier test difficile de pouvoir dire grand chose... car tu fait reference a des contenus de cellules, mais on ne sais pas ce qu'il y a dedans....

peut-être un chemin trop long

un caractère interdit dans le nom de fichier

une piste de reflexion... commencer par faire un code qui fonctionne en local sur la machine et une fois opérationnel d'adapter pour un fonctionnement réseau

fred

Le 16/06/2016 à 09:49

Ci-joint le fichier.

Je teste de mon côté en changeant les chemins sur le disque personnel avant le réseau.

Je reviens en fin de matinée.

PS: Merci de m'aider c'est vraiment cool.

14classeur-saisi.xlsm (100.92 Ko)

Le 16/06/2016 à 10:00

et bah cherche pas... le problème vient de deux choses

tu fais :

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier

hors

fichier = nom_fichier & ".pdf"

il faut indiquer le chemin d'enregistrement au complet....

deuxième chose

ton nom de fichier est :

fichier = toto2-selestat-16.06.16.pdf

je penses qu'il y a trop de "." (points) dans ce nom de fichier

fred

Le 23/06/2016 à 14:34

Bonjour,

Pour les intéressés voila la solution. Encore merci a tous ceux qui on participer et pris du temps de me répondre.

Sub test()

'Enregistre le fichier suivant le contenu de la cellule

Dim Dossier As String, Fichier As String, Chemin, produit As String

produit = ActiveSheet.Range("B6").Value
NomDossier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8").Value

nom_fichier = ActiveSheet.Range("B4") & " - " & ActiveSheet.Range("B30") & " - " & ActiveSheet.Range("B8")
Fichier = nom_fichier & ".pdf"
Application.DisplayAlerts = False

Call SetUNCPath("\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & "\")

 MkDir "\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & "\" & NomDossier
 ChDir "\\file01sel\data_selestat\commercial\SUIVI ECHANTILLONS\" & produit & "\" & NomDossier
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub

Finalement assez simple et le problème ne venait pas du nom du fichier des ".", mais bien du chemin donné par MkDir et ChDir.

Cordialement.

Rechercher des sujets similaires à "vba chemin enregistrement"