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
 

Fichiers joints

  • 370.5 Ko Affichages: 40

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+
 

Fichiers joints

Dernière édition:

HICHAM1

XLDnaute Nouveau
Bsr
merci bq job75 pour ta réponse mais ce code enregistre seulement la première bulletin
essaie le mien il enregistre les bulletins de 24 élèves de la classe.
 

job75

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

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
 

job75

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

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.
 

Fichiers joints

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+
 

Fichiers joints

HICHAM1

XLDnaute Nouveau
Re,

Merci, voici donc la nouvelle macro dans ce fichier (2) :

A+
Merci infiniment pour votre collaboration
Mais pour Fichier PDF groupé
il change seulement le numéro mais il garde bulletin du premier élève et le recopie 24 fois
Svp tu peux tu peux vérifier
 

job75

XLDnaute Barbatruc
Re,

En remplaçant $N$5 par N5 dans les 2 feuilles "bulletins" je pense que c'est bon, vérifiez ce fichier (3).

Bonne nuit.
 

Fichiers joints

HICHAM1

XLDnaute Nouveau
Bon nuit
Merci infiniment
c 'est bon;mais il reste un petit detail
chaque bulletin dans une feuille
nombre élèves = nombre de feuilles
et Merci infiniment
 

Discussions similaires


Haut Bas