XL 2010 svp comment modifier ce code vba??

HICHAM1

XLDnaute Nouveau
Bonjour
svp
ce code vba :se trouve au botton pdf bulletin_sem
==========================================================================
Sub Macro1()
'
' Macro1 Macro
'

Application.ScreenUpdating = False
For i = 1 To [N7]
[N5] = i
ActiveCell.FormulaR1C1 = "i"
Dim fdObj As Object
Application.ScreenUpdating = False
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\Users\pc\Desktop\sauvegarde ") Then
Else
fdObj.CreateFolder ("C:\Users\pc\Desktop\sauvegarde")
MsgBox "dossier sauvegarde a été creé sur bureau", vbInformation, "HICHAM:"
End If
Application.ScreenUpdating = True

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\pc\Desktop\sauvegarde\" & [N5] & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Next
[N5] = 1
MsgBox "Hicham: Bravoo les bulletins sont dans dossier sauvegarde", , Now()

End Sub
===============================================================================================
enregistre les bulletins en pdf mais en fichiers individuels
svp
comment le modifier afin qu il ouvre msgbox et choisir entre fichiers individuels ou tout dans un fichier
si l' utulisateur a choisi fichiers individuels les reçoi individuels
et si a choisi tout en 1 les reçoi groupés
et merci bq
 

Pièces jointes

  • D.xlsm
    370.5 KB · Affichages: 44

job75

XLDnaute Barbatruc
Bonjour HICHAM1, bienvenue sur XLD,

Il faudrait savoir ce que vous entendez par "fichiers individuels" mais bon...

Voyez le fichier joint et cette macro :
Code:
Sub PDF()
If Not ActiveSheet.Name Like "bulletin*" Then Exit Sub 'sécurité
Dim chemin$, rep As Byte, i&
chemin = ThisWorkbook.Path & "\"
rep = MsgBox("Placer le(s) fichier(s) PDF dans le dossier 'Sauvegarde' ?'", 3)
If rep = 2 Then Exit Sub
If rep = 6 Then chemin = chemin & "Sauvegarde\": If Dir(chemin, vbDirectory) = "" Then MkDir chemin
For i = 1 To Val([N7])
    [N5] = i
    ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & [N5] & ".pdf"
Next
[N5] = 1
MsgBox i - 1 & " fichier(s) PDF publié(s)..."
End Sub
Edit : mis une sécurité au début.

A+
 

Pièces jointes

  • D(1).xlsm
    303.4 KB · Affichages: 34
Dernière édition:

HICHAM1

XLDnaute Nouveau
Bonjour HICHAM1, le forum,

Ma macro est correcte mais je n'avais pas mis le bon fichier (le vôtre), c'est corrigé au post #2.

Bonne journée.
Bonsoir job75, le forum,

merci pour ton effort
mais
svp
comment le modifier afin qu il ouvre msgbox et choisir entre fichiers individuels (comme cette cas)ou tout dans un seul fichier groupés
si l' utulisateur a choisi fichiers individuels les reçoi individuels(comme cette cas)
et si a choisi tout en 1 les reçoi groupés
et merci bq
 

HICHAM1

XLDnaute Nouveau
Bonjour HICHAM1, le forum,

Ma macro est correcte mais je n'avais pas mis le bon fichier (le vôtre), c'est corrigé au post #2.

Bonne journée.
Bonjour HICHAM1, le forum,

Nous ne savons toujours pas ce que vous voulez dire par "tout dans un seul fichier groupé".

Il faudrait donner un exemple.

Bonne journée.
Bonjour Job75, le forum,

"tout dans un seul fichier groupé".

un exemple,voir piece jointe.

Bonne journée.
 

Pièces jointes

  • bulletins groupés.pdf
    148.7 KB · Affichages: 25

job75

XLDnaute Barbatruc
Re,

Merci, voici donc la nouvelle macro dans ce fichier (2) :
Code:
Sub PDF()
If Not ActiveSheet.Name Like "bulletin*" Then Exit Sub 'sécurité
Dim chemin$, rep As Byte, a$, h&, i&
chemin = ThisWorkbook.Path & "\Sauvegarde\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du dossier
rep = MsgBox("Grouper en un seul fichier PDF ?'", 3)
If rep = 2 Then Exit Sub
Application.ScreenUpdating = False
With ActiveSheet
    .PageSetup.Zoom = False
    .PageSetup.FitToPagesTall = 1 '1 page en hauteur, détermine le zoom
    If rep = 6 Then 'Oui
        a = .PageSetup.PrintArea
        h = .Range(a).Rows.Count
        .Copy 'nouveau document
        With ActiveSheet
            .PageSetup.PrintArea = ""
            For i = 1 To Val(.[N7] - 1)
                .Range(a).EntireRow.Offset(h * i - h).Copy .[A1].Offset(h * i)
                .[N5].Offset(h * i) = i + 1
                .HPageBreaks.Add Before:=.[A1].Offset(h * i) 'saut de page
            Next
            .PageSetup.PrintArea = .Range(a).Resize(h * i).Address
            .PageSetup.FitToPagesTall = i
            .ExportAsFixedFormat xlTypePDF, chemin & "Groupé.pdf"
            .Parent.Close False 'fermeture du document
        End With
        MsgBox "Fichier PDF groupé publié..."
    Else 'Non
        For i = 1 To Val(.[N7])
            .[N5] = i
            .ExportAsFixedFormat xlTypePDF, chemin & .[N5] & ".pdf"
        Next
        .[N5] = 1
        MsgBox i - 1 & " fichier(s) PDF publié(s)..."
    End If
End With
End Sub
A+
 

Pièces jointes

  • D(2).xlsm
    306.9 KB · Affichages: 34

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo