Bonjour, J'utilise Excel 2007, VB editor 6.5. Je souhaite créer une commande macro qui puisse me permettre de créer une version PDF de mon fichier Excel. Mon fichier excel comprend plusieurs feuilles à imprimer puis une feuille comprenant la Cells Range utilisée en Data Validation dans la zone non imprimable de chaque feuille dont la zone d'impression est importante à imprimer. Je voudrai créer chaque pdf de ce fichier correspondant à chaque valeur de la Cells Range intitulée "Transportai". Il y a un tarif de transport qui part de 0 jusqu'à 3000 EUR et qui change tous les 25 EUR. A chaque valeur de transport, je veux créer une version pdf de mon fichier, en créant sur le desktop un nouveau répertoir "Offres", comprenant un lui même un sous répertoire intitulé "valeur du transport" (par exemple 0, puis un autre 25, un autre 50 etc... jusqu'à 3000). Chacun de ces répertoires comprendra une version PDF de mon fichier excel. J'ai testé une macro ainsi : Sub test() ' ' test Macro ' ' For Each L18 In Selection If L18.Value Like "Transportai" Then ChDir "C:\Documents and Settings\Admin\Desktop\OFFRE" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Documents and Settings\Admin\Desktop\PASIULYMAI\2009_10_06_Pasiulymas_padeklams.pdf" _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End If Next End Sub Je ne vois pas d'où vient le problème, mais il n'y a aucun effet. Ca ne crée aucun répertoire sur le desktop, d'une part. D'autre part, j'aimerai que pour chacune du transport, la macro me créée un répertoire intitulé par la valeur du transport donnée et y inclue une copie PDF de mon fichier. Merci de bien vouloir m'aider.

Je te remercie pour ce nouveau code qui marche normalement, sous MS OFFICE 2007. Cependant, j'ai une question. J'ai encore une question par rapport aux versions différentes de MS Office parmi tous mes collègues. En effet, j'ai des collègues qui possèdent encore la version MS OFFICE 2003. Et j'ai pu tester avec deux ordis dont les excels tournent sous cette version, la zone sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ne fonctionne pas. Je ne sais pas, mais je pense que la version 2003 n'accepte pas le SAVE AS *.pdf autrement dit, xlTypePDF en VB. Pourrait-on vraiment sauvegarder cette offre en format PDF sous MS Office 2003 ??? Ou faudra-t-il inclure des lignes dans le code, afin que la macro puisse vérifier la version de Excel utilisée, et appliquer si c'est 2007, le code actuel, si c'était 2003, un autre code adapté ? Merci encore pour ce dernier problème. HYNERYL

Bonjour, face à ce nouveau problème, je n'ai pas de réponse. Office 2007 exporte en format pdf, Office 2003 ne le fait pas. Est-ce possible? Sans doute, mais je ne l'ai jamais fait. Une solution simple serai imprimer le fichier en installant un module comme PDF995 ou un autre ce petit soft (gratuit) se comporte comme une imprimante et crée des document PDF au lieu de les diriger vers l'imprimante. Il serait possible de faire un ".print..." classique en prenant en compte cette imprimante génératrice de PDF Faire ce choix ne m'appartient pas. Je te rappelle que tu es sur un forum d'entraide. On peut conseiller mais pas décider pour les autres. Je te souhaite une bonne journée. Et si tu penses que c'est ok .... passe le premier post en résolu. Merci R

Bidouilleu_R, rebonjour, j'ai d'ores et déjà appliqué le résultat "Résolu" à tes postes. Cependant, il existe bel et bien, le logiciel Primo pdf que nous utilisons pour les anciennes versions de MS Office afin de pouvoir créer les pdf de nos feuilles excel ou word 2000/2003. Dans ce cas, quelle serait la possibilité afin de pouvoir faire en sorte que cette macro du poste 42, soit valable pour la version 2007, et si la version est antérieure à 2007, ben que ça puisse passer par l'imprimante tampon de primo pdf ?

Macro Boucle Cells Range - Page 3

Réponse 41 / 44
hyneryl_ramundas
Shell ("explorer.exe " & ThisWorkbook.Path & TextBox2), 1

J'ai pensé à ce code, ça pourrait répondre à mon attente de pouvoir réaliser une commande macro unique, sans que le systeme d'operation ne soit un probleme je pense.

Dans ce cas, il faudrait remanier le code de ta macro dans le passage MyPath en mettant :

MyPath = ThisWorkbook.Path & PASIULYMAI
ou bien
MyPath = ThisWorkbook.Path & "\" & PASIULYMAI

je ne sais pas soit l'un soit l'autre car apres dans la ligne ChDir MyPath, ça me met du coup, 2antislashes au lieu d'un si je mets ThisWorkbook.Path & "\" & PASIULYMAI et ça me bloque ensuite au passage ci :

Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyPath & "\" & NomFichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

(ça me met toujours MyPath équivalent au chemin d'accès suivi de \\ et du titre du sous-rep 0 par exemple car c'est le premier sous-repertoire que la macro va créer).

Je te joinds le code que jai tente de realiser
j'y ai ajoute une ouverture du dossier PASIULYMAI a la fin de lexecution de la macro, mais jy ai pour le moment une erreur dans le passage cidessus.

Sub test3()
'
' test3 Macro
'

'

Dim MyPath As String ' le chemin
Dim MyName As String ' l'entrée du repertoire ou le fichier
Dim DossierTransport As String ' le numero pour créer le dossier
Dim LaDate As Date ' la date du jour
Dim ChaineDate As String 'contient la date en chaine
Dim TempMois As String
Dim TempJour As String
Dim Utilisateur As String ' contient le nom pour créer le PDF
Dim Langue As String ' contient la langue (2 lettres)
Dim NomFichier As String ' le nomdéfinitif du fichier
Dim I As Integer ' compteur

Dim TabLangue(6) As String

TabLangue(0) = "EN"
TabLangue(1) = "FR"
TabLangue(2) = "IT"
TabLangue(3) = "DE"
TabLangue(4) = "ESP"
TabLangue(5) = "LT"
' ici la boucle pour le choix des langue

While Langue = ""
Langue = InputBox("choisissez la langue..." & Chr(10) & Chr(10) & "Click sur annuler " & Chr(10) & "pour changer de langue " & Chr(10) & Chr(10) & "....> suivant ", "choix de la langue", TabLangue(I))
I = I + 1
If I > UBound(TabLangue) Then Exit Sub
Wend

LaDate = Format(Date, "yyyy/mm/dd")

TempMois = CStr(Month(LaDate))
If Len(TempMois) < 2 Then TempMois = "0" & TempMois
TempJour = CStr(Day(LaDate))
If Len(TempJour) < 2 Then TempJour = "0" & TempJour
ChaineDate = CStr(Year(LaDate)) + TempMois + TempJour
'***********************************************

Utilisateur = "_pasiulymas_padeklu_ramundas_"

'***********************************************
' la langue sera gérée dans la boucle

MyPath = ThisWorkbook.Path & PASIULYMAI
MyName = Dir(MyPath, vbDirectory)
If MyName = "" Then
MkDir MyPath
End If
ChDir MyPath
'ChDir ThisWorkbook.Path & PASIULYMAI

Sheets(Langue).Select ' on sélectionne la feuille de la langue
'celle-ci sera exportée 80 fois ou plus
Application.ScreenUpdating = False
For I = 0 To 2000 Step 25
Sheets(Langue).Range("L18").Value = I 'on place la valeur du transport
'le nom du fichier en sortie devient
NomFichier = ChaineDate + Utilisateur + Langue

'je vérifie l'existance du sousrépertoire
'et s'il n'existe pas il y a création
'création des 80 ou plus
DossierTransport = Sheets(Langue).Range("L18").Value ' ou i

MyPath = MyPath & DossierTransport
'MyPath = ThisWorkbook.Path & PASIULYMAI
MyName = Dir(MyPath, vbDirectory)
If MyName = "" Then
MkDir MyPath
End If
ChDir MyPath ' on se positionne au bon endroit

'if range("L17").value like.... ' note L17 doit e^tre entre crochets
If Sheets(Langue).Range("L17").Value Like "Transport :" Then
'en mettant Sh.name le fichier Pdf portera le nom de la feuille

Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyPath & "\" & NomFichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If

MyPath = Mid(MyPath, 1, Len(MyPath) - Len(DossierTransport) - 1)

Next
Application.ScreenUpdating = True
Sheets(Langue).Select
Shell ("explorer.exe " & ThisWorkbook.Path & "\" & PASIULYMAI & TextBox2), 1

End Sub

0

Réagir

Bidouilleu_R

j' ai modifié le fichier pour intégrer le thisworkbook.path

on fait donc thisworkbook.path ( endroit ou est enregistré le fichier)

..\PASIULYMAI\0\2 fichier pdf

Sub test3()
'
' test3 Macro
'

'

Dim MyPath As String  ' le chemin
Dim LgInit As Integer ' la longueur du chemin MyPath
Dim MyName As String  ' l'entrée du repertoire ou le fichier
Dim DossierTransport As String  ' le numero pour créer le dossier
Dim LaDate As Date ' la date du jour
Dim ChaineDate As String 'contient la date en chaine
Dim TempMois As String
Dim TempJour As String
Dim Utilisateur As String ' contient le nom pour créer le PDF
Dim Langue As String  ' contient la langue (2 lettres)
Dim NomFichier As String ' le nomdéfinitif du fichier
Dim NomFichier2 As String ' le nom du fichier pdf Sand à exporter
Dim FeuilleSand As String ' le nom d'onglet --feuille Sand
Dim I As Integer ' compteur

Dim TabLangue(6) As String


TabLangue(0) = "EN"
TabLangue(1) = "FR"
TabLangue(2) = "IT"
TabLangue(3) = "DE"
TabLangue(4) = "ESP"
TabLangue(5) = "LT"


While Langue = ""
Langue = InputBox("choisissez la langue..." & Chr(10) & Chr(10) & "Click sur annuler " & Chr(10) & "pour changer de langue " & Chr(10) & Chr(10) & "....> suivant ", "choix de la langue", TabLangue(I))
I = I + 1
If I > UBound(TabLangue) Then Exit Sub
Wend

LaDate = Format(Date, "yyyy/mm/dd")

TempMois = CStr(Month(LaDate))
If Len(TempMois) < 2 Then TempMois = "0" & TempMois
TempJour = CStr(Day(LaDate))
If Len(TempJour) < 2 Then TempJour = "0" & TempJour
ChaineDate = CStr(Year(LaDate)) + TempMois + TempJour
'***********************************************

Utilisateur = "_pasiulymas_ramundas_"

'***********************************************
' la langue sera gérée dans la boucle


MyPath = ThisWorkbook.Path
MyPath = MyPath + "\PASIULYMAI"

MyName = Dir(MyPath, vbDirectory)
If MyName = "" Then
    MkDir MyPath
End If
ChDir MyPath


Sheets(Langue).Select ' on sélectionne la feuille de la langue
'celle-ci sera exportée 80 fois ou plus
Application.ScreenUpdating = False
For I = 0 To 2000 Step 25
    Sheets(Langue).Range("L18").Value = I 'on place la valeur du transport
    
    'le nom du fichier en sortie devient
    NomFichier = ChaineDate + "_Promotion_Rasmundas_" + Langue
    NomFichier2 = ChaineDate + "_Sand_" + Langue
    
    'je vérifie l'existance du sousrépertoire
    'et s'il n'existe pas il y a création
    'création des 80 ou plus
    DossierTransport = Sheets(Langue).Range("L18").Value  ' ou i

    MyPath = MyPath & "\" & DossierTransport
    
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit

'if range("L17").value like.... ' note L17 doit être entre crochets
    If Sheets(Langue).Range("L17").Value Like "Transport :" Then
       'en mettant Sh.name le fichier Pdf portera le nom de la feuille

        Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        FeuilleSand = Langue + "_Sand"
        Sheets(FeuilleSand).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier2, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        
    End If
    
    MyPath = Mid(MyPath, 1, Len(MyPath) - Len(DossierTransport) - 1)
    LgInit = Len(MyPath)
    'On ajoute le répertoire SANDELYJE
    MyPath = MyPath & "\SANDELYJE"
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit
    'On ajoute le répertoire SANDELYJE\0 ...2000
    MyPath = MyPath & "\" & I
    MyName = Dir(MyPath, vbDirectory)
    If MyName = "" Then
      MkDir MyPath
    End If
    ChDir MyPath ' on se positionne au bon endroit
    'on peut ajouter une feuille Ici
    
        Sheets(Langue).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        
        Sheets(FeuilleSand).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyPath & "\" & NomFichier2, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    'on revient à la racine
    MyPath = Left(MyPath, LgInit)
    ChDir (MyPath)
    
    
Next
Application.ScreenUpdating = True
Sheets(Langue).Select
End Sub

Réponse 43 / 44
hyneryl_ramundas
Je te remercie pour ce nouveau code qui marche normalement, sous MS OFFICE 2007.

Cependant, j'ai une question.
J'ai encore une question par rapport aux versions différentes de MS Office parmi tous mes collègues.

En effet, j'ai des collègues qui possèdent encore la version MS OFFICE 2003.
Et j'ai pu tester avec deux ordis dont les excels tournent sous cette version, la zone
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ne fonctionne pas.

Je ne sais pas, mais je pense que la version 2003 n'accepte pas le SAVE AS *.pdf autrement dit, xlTypePDF en VB.

Pourrait-on vraiment sauvegarder cette offre en format PDF sous MS Office 2003 ???
Ou faudra-t-il inclure des lignes dans le code, afin que la macro puisse vérifier la version de Excel utilisée,
et appliquer si c'est 2007, le code actuel, si c'était 2003, un autre code adapté ?

Merci encore pour ce dernier problème.
HYNERYL

0

Réagir
Réponse 44 / 44
hyneryl_ramundas
Bidouilleu_R,

rebonjour,

j'ai d'ores et déjà appliqué le résultat "Résolu" à tes postes.

Cependant, il existe bel et bien, le logiciel Primo pdf que nous utilisons pour les anciennes versions de MS Office afin de pouvoir créer les pdf de nos feuilles excel ou word 2000/2003.

Dans ce cas, quelle serait la possibilité afin de pouvoir faire en sorte que cette macro du poste 42, soit valable pour la version 2007, et si la version est antérieure à 2007, ben que ça puisse passer par l'imprimante tampon de primo pdf ?

0

Réagir
Précédent
- 1
- 2
- 3

Macro Boucle Cells Range - Page 3

Discussions similaires

Newsletters