XL 2010 Export d'une feuille sur le bureau

[Ternoise]

Bonjour à tous.

Meilleurs Vœux !

Je lance cette procédure depuis un bouton de la feuille "Menu"
Celui-ci fonctionne parfaitement mais j'aimerais y apporter quelques modifications.

1 - Ne plus voir la procédure s'effectuer et rester sur la feuille "MENU"

2 - Pour la version PDF :
- seulement copier les données de la plage nommée "Tableau1"
- La plage nommée étant large, réduire la largeur pour éviter le nombre de feuille

Optionnel : L'idéal serait d'automatiser l'envoi du mail !

Merci beaucoup d votre aide
Bonne journée

David

'*  MISE A JOUR - Permet de créer un fichier PDF et XLS sur le bureau de l'utilisateur
'**************************************************************************************************************************************
Sub exportation()
 
  Dim Fso As Object

  Application.ScreenUpdating = True

  Sheets("BD").Select
 
  Dim LaDate, LeNom As String, LeRep As String

  LaDate = Format(Now(), "dddd dd mmmm yyyy hh - hh mm ss")
  LeNom = "ESSAI - Mise à jour"
 
  ' l'exportation à lieu sur le bureau de l'utilisateur
  LeRep = Environ("userprofile") & "\desktop" & "\Dossier des Mises à jour ESSAI à envoyer"
 
  ' Créer un intance de FileSystemObject
  Set Fso = CreateObject("Scripting.FileSystemObject")
 
  ' Vérifier si le dossier existe ou on
  If Not (Fso.FolderExists(LeRep)) Then
    
  ' Sinon le créer
  MkDir LeRep
 
  End If
 
  ' Libérer la variable objet
  Set Fso = Nothing
 
  ' Exporter le graphique PDF
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                  LeRep & "\" & LeNom & " " & "du" & " " & LaDate & ".pdf", Quality:= _
                                  xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False
                                  'From:=1, To:=1, OpenAfterPublish:=False
                                  
  'Copie de la feuille en xls
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs Filename:=LeRep & "\" & LeNom & " " & "du" & " " & LaDate & ".xls"
  ActiveWorkbook.Close
 
  Application.ScreenUpdating = True
  
  Sheets("MENU").Select

  MsgBox " Le fichier [ ESSAIS pour mise à jour ] vient d'être créer - Merci de me transmettre la version XLS en Mail - En retour, je vous enverrai la dernière version !"
 
End Sub

 

[Sequoyah]

Bonjour David,
voici le code. Pour adapter le tableau sur une seule page la meilleure solution est probablement d’ajuster manuellement la taille de la même avant de lancer la macro, voir ici pour plus de détails. Pour l'envoi du mail le mieux c'est peut-être d'ouvrir un nouveau sujet avec toutes les informations utiles (tu utilise Outlook? il faut ajouter une pièce jointe?, les données nécessaires - adresse, sujet, corps du mail, etc. figurent sur le fichier ou dans le code?).

Sub exportation2()
    Dim Fso As Object
    Dim WsBD As Worksheet

    Set WsBD = Sheets("BD")
    
    Application.ScreenUpdating = False
    
    With WsBD
        Dim LaDate, LeNom As String, LeRep As String, Fichier As String, Classeur As String
        
        LaDate = Format(Now(), "dddd dd mmmm yyyy hh - hh mm ss")
        LeNom = "ESSAI - Mise à jour"
        
        ' l'exportation à lieu sur le bureau de l'utilisateur
        LeRep = Environ("userprofile") & "\desktop" & "\Dossier des Mises à jour ESSAI à envoyer\"
              
        Fichier = LeRep & LeNom & " du" & " " & LaDate & ".PDF"
        
        Classeur = LeRep & LeNom & " du" & " " & LaDate & ".xls"
        
        ' Créer un intance de FileSystemObject
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        ' Vérifier si le dossier existe ou on
        If Not (Fso.FolderExists(LeRep)) Then
            
            ' Sinon le créer
            MkDir LeRep
            
        End If
        
        ' Libérer la variable objet
        Set Fso = Nothing
        
        ' Exporter le graphique PDF
        
        .ListObjects("Tableau1").Range.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                           Fichier, Quality:= _
                                                           xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                                           OpenAfterPublish:=False
        
        'Copie de la feuille en xls
        .Copy
        With ActiveWorkbook
            .SaveAs Filename:=Classeur
            .Close
        End With
    End With
    
    MsgBox " Le fichier [ ESSAIS pour mise à jour ] vient d 'être créer - Merci de me transmettre la version XLS en Mail - En retour, je vous enverrai la dernière version !"
    Application.ScreenUpdating = True
End Sub

 

[Ternoise]

Bonsoir Sequoyah

Merci de cette réponse. Toutefois j'ai ce message "L'indice n'appartient pas à la sélection"

       .ListObjects("Tableau1").Range.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                           Fichier, Quality:= _
                                                           xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                                           OpenAfterPublish:=False

 

[Sequoyah]

Bonjour David,
c'est ma faute, je n'avais pas réalisé qu'il s'agit d'une plage nommée, je croyais que c'était un tableau.

Remplace la ligne qui renvoie l'erreur avec

.Range("Tableau1").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                                           Fichier, Quality:= _
                                                           xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                                           OpenAfterPublish:=False

 

[Ternoise]

Et oui c'est une plage nommée et... et du coup, je n'ai plus la première ligne 1 (entête de colonne) Zut !
Une solution pour cela ?

Sinon pour la mise en page, c'est nickel.

Pour l'automatisation du mail, je vais chercher si je trouve quelque chose de similaire.
Vu que c'est les utilisateurs qui vont m'envoyer la MAJ, je pense qu'il y a forcement plusieurs solutions suivant le logiciel de messagerie.

Merci beaucoup de l'aide