Autres fenêtre "Publication"

ph.vanne

ph.vanne

XLDnaute Junior
bonjour à tous ,
j'ai une macro ,qui fonctionnait parfaitement auparavant ,et qui depuis deux jours me donne du fil a retordre !!
en effet, au lancement de la macro j'ai maintenant une fenêtre qui s'affiche : " Publication... " avec une barre de progression en vert qui avance lentement .. (très lentement )
la macro fini par s'exécuter , sans erreur , mais cela prends désormais 2 minutes 30 !
avez vous une idée..?




la macro en question :



Sub imprimer_et_envoyer_par_mail()





Application.ScreenUpdating = False


PieceJointe = Environ("Temp") & "\" & "Réservation_" & Range("h4")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PieceJointe & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Destinataire = Range("B15")
Sujet = Range("B1") & " " & Range("E3")
nom = Range("D8")
Texte = "Bonjour" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Merci de bien vouloir trouver ci-joint votre réservation en objet." & Chr(10) & Chr(13) & "merci de la contrôler afin de vérifier l'ensemble des informations." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Bien cordialement." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "La réception."

Mail = "C:\Program Files\Mozilla Thunderbird Beta\thunderbird.exe"

monCourriel = " -compose " & "to=" & Destinataire & "," & "subject=" & Sujet & "," & "body=" & Texte & "," & "attachment=" & PieceJointe & ".pdf"
Shell Mail & monCourriel, vbNormalFocus




Application.Dialogs(xlDialogPrinterSetup).Show




'apres selection de l imprimante ,imprimer la fiche de reservation

Sheets("fiche client").Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False

'Enregistrement dans le dossier FICHES CLIENT sur le Bureau

Dim LeRep As String, NomDossier As String, madate As String, madate2 As String
LeRep = ThisWorkbook.Path & "\"

madate = Range("G19")
madate2 = Format(madate, "_dd-mm-yy")
NomDossier = Range("H4")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
LeRep & NomDossier & madate2 & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=True

'copie des informations dans "Liste reservations" '

'copie du nom

Sheets("fiche client").Select
Range("H4").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'copie du prenom

Sheets("fiche client").Select
Range("H7").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("b2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'copie de la date d'arrivée

Sheets("fiche client").Select
Range("g18").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("d2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


'copie de la date de départ

Sheets("fiche client").Select
Range("g22").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("e2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


'copie de la date d'enregistrement de la reservation

Sheets("fiche client").Select
Range("B52").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("f2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("f2").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"


'copie de l'heure

Sheets("fiche client").Select
Range("B53").Select
Selection.Copy
Sheets("Liste reservations").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G2").Select
Application.CutCopyMode = False
Selection.NumberFormat = "hh:mm"

'copie la ligne de "Liste reservations" et colle sur la derniere ligne non vide de "RESERVATIONS"

Sheets("Liste reservations").Select
Rows(Range("A65535").End(xlUp).Row).Select
Selection.Copy
Sheets("RESERVATIONS").Select
Range("A" & Range("A65535").End(xlUp).Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A" & Range("A65535").End(xlUp).Row + 1).Select






Sheets("fiche client").Select
Range("H4:AH5").Select





Application.ScreenUpdating = True

'Enregistrer et fermer le classeur'

ActiveWorkbook.Save

ActiveWorkbook.Close False
DoEvents
Application.Quit
End Sub
 
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Hello

sans voir ton fichier, difficile de dire ce qui ralentit ton code..
un changement dans ta boite mail? dans ton imprimante?

en attendant, tu peux peut-être "simplifier" ta macro en évitant les select, copy, pastespecial par ceci
VB: 
Sub imprimer_et_envoyer_par_mail()

Application.ScreenUpdating = False

    With ActiveSheet
        PieceJointe = Environ("Temp") & "\" & "Réservation_" & .Range("h4")
    
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PieceJointe & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
        Destinataire = .Range("B15")
        Sujet = .Range("B1") & " " & .Range("E3")
        nom = .Range("D8")
        Texte = "Bonjour" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Merci de bien vouloir trouver ci-joint votre réservation en objet." & Chr(10) & Chr(13) & "merci de la contrôler afin de vérifier l'ensemble des informations." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Bien cordialement." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "La réception."
    End With
    Mail = "C:\Program Files\Mozilla Thunderbird Beta\thunderbird.exe"
    
    monCourriel = " -compose " & "to=" & Destinataire & "," & "subject=" & Sujet & "," & "body=" & Texte & "," & "attachment=" & PieceJointe & ".pdf"
    Shell Mail & monCourriel, vbNormalFocus

    Application.Dialogs(xlDialogPrinterSetup).Show

'apres selection de l imprimante ,imprimer la fiche de reservation
    Sheets("fiche client").Select
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    'Enregistrement dans le dossier FICHES CLIENT sur le Bureau
    
    Dim LeRep As String, NomDossier As String, madate As String, madate2 As String
    LeRep = ThisWorkbook.Path & "\"
    
    With ActiveSheet
        madate = .Range("G19")
        madate2 = Format(madate, "_dd-mm-yy")
        NomDossier = .Range("H4")
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=LeRep & NomDossier & madate2 & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True
    End With
    'copie des informations dans "Liste reservations" '
    
    'copie du nom
    Sheets("Liste reservations").Range("A2") = Sheets("fiche client").Range("H4").Value
    
    'copie du prenom
    Sheets("Liste reservations").Range("b2") = Sheets("fiche client").Range("H7").Value
    
    'copie de la date d'arrivée
    Sheets("Liste reservations").Range("d2") = Sheets("fiche client").Range("g18").Value
    
    'copie de la date de départ
    Sheets("Liste reservations").Range("e2") = Sheets("fiche client").Range("g22").Value
    
    'copie de la date d'enregistrement de la reservation
    
    Sheets("Liste reservations").Range("f2") = Sheets("fiche client").Range("B52").Value
    Sheets("Liste reservations").Range("f2").NumberFormat = "dd/mm/yyyy"
        
    'copie de l'heure
    Sheets("Liste reservations").Range("G2") = Sheets("fiche client").Range("B53").Value
    Sheets("Liste reservations").Range("G2").NumberFormat = "hh:mm"
    
    'copie la ligne de "Liste reservations" et colle sur la derniere ligne non vide de "RESERVATIONS"
    With Sheets("Liste reservations")
        LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
        Set LigToCopy = .Rows(LastLine)
    End With
    With Sheets("RESERVATIONS")
        LastLine = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        .Range("A" & LastLine) = LigToCopy
    End With
    
    Sheets("fiche client").Select
    'Range("H4:AH5").Select
        
    Application.ScreenUpdating = True
    
    'Enregistrer et fermer le classeur'
    ActiveWorkbook.Close Savechanges:=True
    DoEvents
    Application.Quit
End Sub
 
Vote positif 0 Vote négatif
ph.vanne

ph.vanne

XLDnaute Junior
je viens de faire un "pas à pas " sur ma macro et c est sur cette ligne que ça coince ...
si ça peux aider ..


.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PieceJointe & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
à moins que
  1. tu es des soucis d’accès au disque system et donc au dossier temp (sécurité ralentissant les process)
  2. tu ai 250 pages dans ta feuille utilisées( peut être a cause de cellule mal nettoyées

ça ne peut pas être ça

un test benchmark avec des repères à chaque étapes serait sans équivoque
comme cça sans fichier et n'etant pas sur ton PC difficile de t'en dire plus

BENCHMARK!!! ;)
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
184
MICHIS
M
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
Phil69970
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
micie1509
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
698
Phil69970
Phil69970
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
525
robpellan52
R
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
635
gwenn49
G
V
  • Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
547
Valter
V
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
701
olivier388
O

Membres actuellement en ligne

6 membres et 44 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 088
Messages
2 116 087
Membres
112 656
dernier inscrit
VNVT