XL 2010 svp comment modifier ce code vba??

HICHAM1 · 15 Août 2018

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

job75 · 15 Août 2018

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+

HICHAM1 · 16 Août 2018

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 · 16 Août 2018

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 · 17 Août 2018

job75 à dit:
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 · 17 Août 2018

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 · 17 Août 2018

job75 à dit:
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.

job75 à dit:
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.

job75 · 17 Août 2018

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+

HICHAM1 · 17 Août 2018

job75 à dit:
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 · 17 Août 2018

Re,

Je ne peux pas faire mieux.

A+

HICHAM1 · 17 Août 2018

Merci infiniment

job75 · 17 Août 2018

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.

HICHAM1 · 18 Août 2018

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

job75 · 18 Août 2018

Bonjour HICHAM1,

HICHAM1 à dit:
chaque bulletin dans une feuille

Pour faire quoi ? Et pourquoi vous ne créez pas les feuilles vous-même ?

A+

XL 2010 svp comment modifier ce code vba??

HICHAM1

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

HICHAM1

XLDnaute Nouveau

job75

XLDnaute Barbatruc

HICHAM1

XLDnaute Nouveau

job75

XLDnaute Barbatruc

HICHAM1

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

HICHAM1

XLDnaute Nouveau

job75

XLDnaute Barbatruc

HICHAM1

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

HICHAM1

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires