Microsoft 365 Copie d'une feuille sur bureau

ExcLnoob

XLDnaute Occasionnel
Bonjour le forum,

J'utilise sur un fichier une macro me permettant de copier une feuille vers le bureau en la renommant et avec la date. Mais voilà, cette macro fonctionne sur un classeur mais mets un temps fou à s'exécuter sur un autre classeur (jusqu'à 10 minutes montre en main...). J'imagine que cela est du au différentes formules, userfoms et autres actions parallèles lors de l'exécution de la commande de copie (mais ça ne reste que mon avis...).
J'ai fait le test, c'est bien la commande Worksheets("Feuil1").Copy qui fait ramer Excel puisqu'en la supprimant ou en la modifiant ça passe.
Malheureusement je souhaite ne copier que la feuille et pas le classeur entier.
Pour info et si cela peut aider, j'ai intégré cette macro dans une autre macro qui envoi un mail avec la copie d'une plage de cellule.
La déroulement de la macro d'envoi de mail dans laquelle est inclue la macro 'Enregistrer' :
1. J'envoie le mail avec la plage de cellule pré-remplie par USF1
2. Je créer la copie de la feuille sur le bureau, j'ouvre l'URL et je déclenche USF3 ('Sub Enregistrer')
3. Je ferme le classeur

Le code en question :
VB:
Option Explicit

Dim dossier As String
Dim bureau As String

Sub Enregistrer()
Application.DisplayAlerts = False
cheminbureau
dossier = bureau & "\"

Worksheets("Feuil1").Copy

With ActiveWorkbook
             .SaveAs Filename:=dossier & Format(Date, "dd.mm.yy - ") & "xxx.xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close

MsgBox "xxxxx" & Chr(10) & Chr(10) & "xxxxx" & Chr(10) & "xxxxxx" & Chr(10) & xxxxxx", vbInformation

Unload UserForm2

Dim URL As String
URL = "xxxxxxx”
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url " & URL)
End With

If MsgBox("xxxxxxx" & Chr(10) & Chr(10) & "xxxx", vbYesNo + vbQuestion) = vbYes Then
UserForm3.Show
Else: ActiveWorkbook.Close
End If
End Sub

Private Sub cheminbureau()

    On Error GoTo TestErreur
    Dim cheminbureau As String

    cheminbureau = ObtenirCheminBureau()

    bureau = cheminbureau
    Exit Sub
TestErreur:
    MsgBox "Une erreur s'est produite..."
End Sub
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

Sachant que cette macro fonctionne très bien sur un autre classeur, qu'est-ce qui pourrait bloquer dans l'autre ?
Auriez-vous une solution plus "efficace" ou plus "light (si tant est que cela soit le problème) ?

Merci par avance pour votre aide
 
Dernière édition:
Solution
N'oubliez pas de définir la zone d'impression :
ThisSheet.PageSetup.PrintArea = ThisSheet.[A1:G16].Address

VB:
Option Explicit

Sub Enregistrer()
Dim FileName    As String
Dim ThisSheet   As Worksheet
Const Chrome = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

    Set ThisSheet = ActiveSheet
        
        ThisSheet.PageSetup.PrintArea = ThisSheet.[A1:G16].Address  ' <-- Zone d'impression à définir
        ThisSheet.PageSetup.Orientation = xlLandscape               ' <-- Orientation de la page
'        ThisSheet.PrintPreview                                      ' <-- Apercu avant impression
        
        FileName = CreateObject("WScript.Shell").specialFolders("Desktop") & "\" & _...

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @ExcLnoob , le Fourm

Une question toute bête, cette
Worksheets("Feuil1").Copy
"Feuil1" contient-elle elle-même des macros évènementielles dans son Private Module ?

Par ailleurs je ne suis pas formel mais créer un object WS.Shell pour trouver ton bureau me parait un peu très lourd...
As-tu essayé ?
cheminbureau = Environ("USERPROFILE") & "\Desktop"

Bonne soirée
@+Thierry
 

fanch55

XLDnaute Barbatruc
Salut,
Quand tu fais un copy d'une feuille sans rien préciser,
Excel copy ta feuille et son code dans un nouveau classeur mais pas les modules .
Cette feuille est ensuite activée .
S'il y a :
- un worksheet_activate dans ta feuille qui fait appel à des modules auxquels elle n'a plus accès , dans le meilleur des cas, elle se plante, dans le pire tu peux avoir un freeze complet d'Excel .
- s'il y a des fonctions personnelles dans les formules, c'est du pareil au même .

Si ta feuille n'a rien de tout cela, il y a un autre problème que je ne saurai cerner sans un exemplaire (édulcoré) du Classeur .

Analyses ce que tu veux sauvegarder et surtout ce que tu veux en faire.
Si c'est une feuille pour juste faire un état ( sans code ), autant la sauvegarder en tant que PDF .
 

ExcLnoob

XLDnaute Occasionnel
Bonsoir @fanch55,
Merci pour ta réponse.

Pas de worksheet_activate mais effectivement, les modules persos peuvent faire buguer le code... Y'en a un peu bcp sur la même feuille...
Faire une copie sans code et juste les valeurs serai sans doute la solution. En Pdf ou en feuille excel simple pourquoi pas.
J'ai tenté la copie PDF mais je souhaite pouvoir l'enregistrer sur le bureau sans définir un chemin figé afin que chaque utilisateur puisse utiliser la macro et j'ai bloqué.... (Débutant...)
Il faudrait que je puisse combiner l'enregistrement sur le bureau (avec une recherche de chemin pour pouvoir l'utiliser sur n'importe quel PC) tout en faisant une copie pdf (en mode paysage car ma plage de cellule ests sur B2:R27)
Perso je bidouille, mais là je sèche...
 

ExcLnoob

XLDnaute Occasionnel
Re-
Merci pour vos retours.

@_Thierry
J'ai tenté de supprimer la macro sur la feuille concernée mais rien n'y fait. Concernant l'extension, si je ne mets pas .xlsx, que puis-je mettre ? J'ai tenté xls, xlsm (même pdf en adaptant le code...) mais malgré cela ca plante et le .pdf me fait la même chose qu'avec le code de fanch55. Il génère un pdf vide en plus de 3 minutes et ne déroule pas le code jusqu'au bout...


@fanch55
Ok mais j'ai une erreur sur :
Filename = CreateObject("WScript.Shell").specialFolders("Desktop") & "\" & _
>Variable non définie
J'ai donc mis Filename As Variant (c'est bon ?) et cela prend environ 3 minutes pour générer un pdf (vide... j'ouvre avec explorer, c'est peut-être cela?) en plus de ne pas dérouler le code jusqu'au bout. En effet, pas d'ouverture d'URL et l'USF3 ne remonte pas.
 

fanch55

XLDnaute Barbatruc
Essayez avec ceci :
affichage de l'aperçu de ce qui va être enregistré en tant que PDF
S'il n'y a rien, il faut vérifier la mise en page et la zone d'impression.

Nota; l'affichage du fichier PDF est assuré par Chrome par la suite
( évite de lancer Microsoft Edge qui semble être votre viewer Pdf par Défaut )

Voir post #12
 
Dernière édition:

ExcLnoob

XLDnaute Occasionnel
Re-
@fanch55
J'ai donc testé votre code. Effectivement j'arrive à voir le PDF en Preview et celui-ci se met en Prod afin que je puisse l'imprimer en PDF sur le bureau.
Par contre il contient 41945 pages.... (d'où la lenteur de la production je pense....)

J'ai enlever le preview et l'affichage URL pour générer directement le PDF sur le bureau (pour "accélerer" la démarche utilisateur) et il s'affiche correctement.
> Du coup j'ai l'impression d'avoir implémenter le même code que précédemment a peu de chose près.... (Désolé..)
Je pense que mon PDF vide d'hier venait de la taille de celui-ci et mon PC devait "rechigner" à l'afficher.

Du coup, pensez-vous possible de n'afficher qu'1 page en mode "paysage" intégrant mes colonnes de B à R ?
En effet pour le moment il y a 41945 pages mais je n'ai qu'une page contenant les infos et elles sont tronquées...

Merci en tout cas!
 

fanch55

XLDnaute Barbatruc
N'oubliez pas de définir la zone d'impression :
ThisSheet.PageSetup.PrintArea = ThisSheet.[A1:G16].Address

VB:
Option Explicit

Sub Enregistrer()
Dim FileName    As String
Dim ThisSheet   As Worksheet
Const Chrome = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

    Set ThisSheet = ActiveSheet
        
        ThisSheet.PageSetup.PrintArea = ThisSheet.[A1:G16].Address  ' <-- Zone d'impression à définir
        ThisSheet.PageSetup.Orientation = xlLandscape               ' <-- Orientation de la page
'        ThisSheet.PrintPreview                                      ' <-- Apercu avant impression
        
        FileName = CreateObject("WScript.Shell").specialFolders("Desktop") & "\" & _
                   Format(Date, "dd.mm.yy - ") & "xxx.pdf"
        ThisSheet.ExportAsFixedFormat _
            FileName:=FileName, _
            Type:=xlTypePDF, _
            From:=1, To:=1, _
            OpenAfterPublish:=False  ' False= pas d'affichage
      
       ' affichage du Pdf par Chrome
       '  Shell (Chrome & " -url " & """" & FileName & """")
    
    Set ThisSheet = Nothing

    MsgBox "xxxxx" & vbLf & vbLf & _
           "xxxxx" & vbLf & _
           "xxxxxx" & vbLf & _
           "xxxxxx", _
           vbInformation
  
    Unload UserForm2
    
    Dim URL As String
    URL = "xxxxxxx”"
    Shell (Chrome & " -url " & URL)
    
    If MsgBox("xxxxxxx" & vbLf & vbLf & "xxxx", vbYesNo + vbQuestion) = vbYes Then
        UserForm3.Show
    Else
        ActiveWorkbook.Close
    End If
End Sub
 

ExcLnoob

XLDnaute Occasionnel
Bin ecouter c'est tout simplement PAR-FAIT!
Merci beaicoup
Tout fonctionne.
Je l'ai même implémenter sur les autres fichers pour avoir un .pdf qui fait plus sérieux que l'excel (et qui évite les modifs en plus...)
Merci BEAU-COUP!!!
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87