Microsoft 365 Projet VBA à affiner

[Chaton77]

Bonsoir,

j'ai fait un programme de contrôle. Dans l'ensemble il marche mais je n'arrive pas à faire certaines actions que je souhaite faire.

Ce qui coince,
j'ai fait un code qui enregistre à la fois un fichier en pdf et un fichier en xlsx :

• dans le nouveau fichier en pdf, il y a deux pages au lieu de une
  
  
• dans le nouveau fichier en xlsx, les boutons de commandes restent (Je n'arrive pas à les enlever avec le code que j'ai fait, alors je l'ai effacé)
  et les supports de signatures (via InkPicture restent affichés)

Si quelqu'un du forum puisse m'aider à affiner le programme, svp.

Je vous remercie à l'avance.

Juju

 

[wDog66]

Bonjour Chaton77

Voici une possibilité de code à utiliser à la place du tiens

'****************************************************
'enregistrer une fiche en pdf et une fiche en xlsx
'****************************************************
Sub EnregistrerFiche()
    Dim ws As Worksheet
    Dim nouveauClasseur As Workbook
    Dim chemin As String
    Dim nomFichier As String
    Dim compteur As Integer
    Dim dateActuelle As String
    Dim Shp As Shape
    ' Définir la feuille à copier
    ' adapter le nom e la feuille selon type de zone
    Set ws = ThisWorkbook.Sheets("Zone0")
    ' Définir le chemin où enregistrer les fichiers
    'adapter le chemin selon choix emplcement
    chemin = "C:\Users\Julia\Documents\Bjn Bionet\"
    ' Initialiser le compteur
    compteur = 1
    ' Obtenir la date actuelle au format JJMMYYYY
    dateActuelle = Format(Date, "dd mm yyyy")
    ' Générer un nom de fichier unique avec la date et incrémentation
    Do While Dir(chemin & dateActuelle & "_Fiche" & compteur & ".xlsx") <> ""
        compteur = compteur + 1
    Loop
    nomFichier = dateActuelle & "_Fiche" & compteur
    ' Copier la feuille dans un nouveau classeur
    ws.Copy
    ' Définir ce nouveau classeur actif
    Set nouveauClasseur = ActiveWorkbook
    ' Supprimer les bouton
    For Each Shp In nouveauClasseur.Sheets(1).Shapes
      Shp.Delete
    Next Shp
    ' Supprimer les colonnes
    Application.EnableEvents = False
    ActiveSheet.Columns("N:Q").Delete
    Application.EnableEvents = True
    ' Zone d'impression pour 1 seule page
    ActiveSheet.PageSetup.PrintArea = "$A$1:$L$28"
    ' Enregistrer en format XLSX
    'On Error GoTo ErreurEnregistrement
    Application.DisplayAlerts = False
    nouveauClasseur.SaveAs Filename:=chemin & nomFichier & ".xlsx", FileFormat:=51   ' xlOpenXMLWorkbook
    ' Enregistrer en format PDF
    nouveauClasseur.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomFichier & ".pdf"    ' xlTypePDF
    Application.DisplayAlerts = True
End Sub

Nota : je n'ai pas vu de support de signature comme indiqué

A+

 

[Chaton77]

Bonjour wDog66,
Le code que tu as proposé fonctionne, même le support de signature ne s'affiche plus.
Merci de ton aide

 

[Chaton77]

Bonsoir,
suite de mon projet. J'ai fait un code pour faire une application mais il bug au niveau :
'activation/désactivation barre de formule
Si quelqu'un peut m'aider?


Private Sub Workbook_Open()

'----------------------------------------------------------
'ouverture du classeur et affichage de la feuille Accueil
'----------------------------------------------------------
Sheets("Accueil").Select

'----------------------------------------------------
'faire une Application avec un menu
'----------------------------------------------------

Dim enabled As Boolean
enabled = False
'activation/désactivation visibilité des onglets
ActiveWindow.DisplayWorkbookTabs = enabled

'activation/désactivation menu contextuel onglet
Application.CommandBars("Ply").enabled = enabled

'activation/désactivation barre de formule
Application.FormulaBar = enabled

'activation/désactivation barre d'état
Application.DisplayStatusBar = enabled

'activation/désactivation entêtes des lignes et colonnes
ActiveWindow.DisplayHeadings = enabled

'activation/désactivation du ruban
If enabled Then
Application.ExecuteExcel4Macro "SHOW.TOOLBAR (""Ribbon"", true)"
Else
Application.ExecuteExcel4Macro "SHOW.TOOLBAR (""Ribbon"", false)"

End If

End Sub

 

[Chaton77]

Suite à ma demande ci-dessus.
J'ai trouvé la solution :

Application.DisplayFormulaBar = enabled

Mon code fonctionne. Peut-être cela aidera les autres.
A+