VBA pour creation onglet en pdf

Le 12/10/2016 à 15:23

Bonjour

Je suis nouvelle sur le forum , et j'ai besoin d'un coup de main pour la réalisation d'une Macro

Je m'explique :

J'ai un fichier Excel ( 2010 ) avec Plusieurs Onglets, qui me servent a suivre une activité

Dans ce fichier , j'ai 3 onglets Indicateur qui ce nomment :

  • Indicateur 1
  • Indicateur 2
  • Indicateur 3

J'aimerais , si cela est possible une macro qui crée un dossier nommé : année + date du jour de l'extraction , dans un dossier existant qui ce nomme " INDICATEUR ANNUEL" qui ce trouve sur le Bureau , et ensuite copie ces 3 onglets en format PDF ( soit 3 fichiers ) avec comme nom : intitulé Onglet + date et ce positionne directement dans le dossier Crée ( année + date du jour de l'extraction )

J'espère que ma demande est clair

Si quelqu'un a la solution , je suis preneuse

Je vous souhaites a toutes et tous une excellent journée

Et en attente de vos réponses

Cordialement

NATH 31

19exemple-pour-macro-pdf.xlsx (40.61 Ko)
Le 12/10/2016 à 17:29
NATH31 a écrit :

Bonjour

Je suis nouvelle sur le forum , et j'ai besoin d'un coup de main pour la réalisation d'une Macro

Bonjour Nath,

Nouvelle sur forum, mais pas sur VBA ? donc juste un coup de main ...

Exemple création répertoire :

Sub creer()

On Error GoTo ErreurCreation

MkDir Application.ActiveWorkbook.Path & "\" & "sous-dossier"
MkDir Application.ActiveWorkbook.Path & "\" & "sous-dossier\sous-sous-dossier"

Exit Sub

ErreurCreation:
    MsgBox "Vérifiez vos droits ou vérifiez que le répertoire n'est pas déjà créé !"
Exit Sub

End Sub

Exemple création pdf :

    nompdf = chemin & "\" & "fichier test"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

et pour le chemin du bureau :

http://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

A toi d'assembler le tout !

Le 13/10/2016 à 06:50

Bonjour

Merci pour votre réponse , et non , je débute en vba

Mais si tu peux m'éclairer un plus sur la marche a suivre ,afin de mettre en place la macro

Je te remercie par avance pour ton aide

Et en espérant te lire bientôt

Te souhaitant une agréable journée

Nath31

Le 13/10/2016 à 12:55

C'est un excellent sujet en effet pour des contrôleurs de gestion (économique, production, commerce)

ci-joint

exécute la macro "pdf"

Sub pdf()

On Error Resume Next

    CheminBureau = ObtenirCheminBureau()
    Dossier = "INDICATEUR ANNUEL"
    DateExtaction = Format(Now(), "yyyy-mm-dd")

    MkDir CheminBureau & "\" & Dossier
    MkDir CheminBureau & "\" & Dossier & "\" & DateExtaction

    For Each onglet In ThisWorkbook.Sheets
        onglet.Select
        nompdf = CheminBureau & "\" & Dossier & "\" & DateExtaction & "\" & onglet.Name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

End Sub

avec

Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( http://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
33exemple-pour-macro-pdf.xlsm (44.75 Ko)
Le 13/10/2016 à 14:41

Bonjour Steelson

Super pour ton aide , je te remercie énormément

Par contre encore une question , comment dire a la macro de prendre que onglet indicateur 1 onglet indicateur 2 et onglet indicateur 3 seulement

Je sais je te demande encore une modification , mais si tu peux juste me dire comment l'écrire dans la macro

En attente de ta réponse

cordialement

Nathalie

Le 13/10/2016 à 14:56

Nath,

Essaie ceci en lieu et place de la boucle ci-dessus

    For Each onglet In ThisWorkbook.Sheets
    If onglet.Name = "Indicateur 1" Or onglet.Name = "Inidcateur 2" Or onglet.Name = "Indicateur 3" Then
        onglet.Select
        nompdf = CheminBureau & "\" & Dossier & "\" & DateExtraction & "\" & onglet.Name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    Next

mais ce n'est pas le plus élégant !

Michel

Le 13/10/2016 à 17:47

Michel

J'ai rajouté ton code ,, mais cela ne fonctionne pas

Voir fichier joint , et ensuite regarde le résultat des fichiers PDF

Merci pour ton aide

Nath

21copie-de-exemple-pour-macro-pdf.xlsm (47.37 Ko)
Le 13/10/2016 à 20:14

Désolé, 2 fautes d’orthographe corrigées !!

Sub pdf()

On Error Resume Next

    CheminBureau = ObtenirCheminBureau()
    Dossier = "INDICATEUR ANNUEL"
    DateExtraction = Format(Now(), "yyyy-mm-dd")

    MkDir CheminBureau & "\" & Dossier
    MkDir CheminBureau & "\" & Dossier & "\" & DateExtraction

    For Each onglet In ThisWorkbook.Sheets
    If onglet.Name = "Indicateur 1" Or onglet.Name = "Indicateur 2" Or onglet.Name = "Indicateur 3" Then
        onglet.Select
        nompdf = CheminBureau & "\" & Dossier & "\" & DateExtraction & "\" & onglet.Name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    Next
End Sub

DateExtraction et Indicateur 2 ...

Le 14/10/2016 à 14:05

Super Steelson , cela fonctionne correctement

Merci beaucoup de ton aide et aussi du temps que tu pris pour m'aider

Te souhaites une excellent Week End

Nath

Le 14/10/2016 à 15:17

Encore une fois, excellent sujet, ne serait-ce que pour garder l'historique ... ou diffuser de l’information !

Le 19/10/2016 à 17:45

Bonjour Steelson

Je viens vers toi , car j'aimerais changer le chemin d'accès des fichiers PDF , et je ne voudrais pas faire n'importe quoi

Avant , je voulais les avoir sur le Bureau , mais maintenant ,je dois changer le chemin que tu trouveras ci dessous

V/Transport/Archive/Indicateur annuel

Me dire la marche a suivre pour la modification

Je te remercie par avance de ton aide

Te souhaites une bonne fin de Journée

Cordialement

Nath31

Le 19/10/2016 à 18:18

Pour plus de clarté, CheminBureau devient Chemin

Essaie ceci, j'ai ajouté :// derrière V (supposition) ...

Sub pdf()

On Error Resume Next

    Chemin= "V://Transport/Archive"
    Dossier = "INDICATEUR ANNUEL"
    DateExtraction = Format(Now(), "yyyy-mm-dd")

    MkDir Chemin & "\" & Dossier
    MkDir Chemin & "\" & Dossier & "\" & DateExtraction

    For Each onglet In ThisWorkbook.Sheets
    If onglet.Name = "Indicateur 1" Or onglet.Name = "Indicateur 2" Or onglet.Name = "Indicateur 3" Then
        onglet.Select
        nompdf = Chemin & "\" & Dossier & "\" & DateExtraction & "\" & onglet.Name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    Next
End Sub
Le 20/10/2016 à 06:59

Bonjour Steelson

J'ai modifié la macro , mais le dossier remonte vide

Ne faut il pas que je modifie aussi la macro ci dessous

Public Function ObtenirCheminBureau() As String

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

Merci pour ton aide

Et en attente de ta réponse

Je te souhaite une bonne Journée

NATH

Le 20/10/2016 à 08:31

Nath,

Tu peux supprimer cette fonction ObtenirCheminBureau() qui ne sert plus à rien. Bon enfin, cela peut toujours resservir.

Si le dossier est vide, c'est qu'il y a une erreur dans Chemin= "V://Transport/Archive"

Je vais faire un essai avec un de mes dossiers ...

En effet, corrige comme suit ...

Sub pdf()

On Error Resume Next

    Chemin= "V:\Transport\Archive"
    Dossier = "INDICATEUR ANNUEL"
    DateExtraction = Format(Now(), "yyyy-mm-dd")

    MkDir Chemin & "\" & Dossier
    MkDir Chemin & "\" & Dossier & "\" & DateExtraction

    For Each onglet In ThisWorkbook.Sheets
    If onglet.Name = "Indicateur 1" Or onglet.Name = "Indicateur 2" Or onglet.Name = "Indicateur 3" Then
        onglet.Select
        nompdf = Chemin & "\" & Dossier & "\" & DateExtraction & "\" & onglet.Name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    Next
End Sub
Le 20/10/2016 à 12:19

Steelson

Super cela fonctionne

Encore merci pour ta patience et ton aide

Te souhaites un bon appétit ainsi qu'une bonne après midi

NATH

Le 20/10/2016 à 13:58

J'espère que tu es maintenant autonome pour adapter le code le cas échéant, c'est le but. Sinon, je suis disponible.

Le 20/10/2016 à 17:11

Steelson

C'est bon , j'ai mis a jour la macro , et elle fonctionne , ( cela grâce a toi )

Mais si j'ai besoin de tes services , je me permettrait de revenir vers toi , si tu es d'accord

Bonne Soirée

Nath

Rechercher des sujets similaires à "vba creation onglet pdf"