[VBA] - Exporter feuille active en .xlsx et garder les couleurs

Bonsoir à tous !

Je voudrais saisir mes devis plus rapidement donc j'ai un classeur Excel avec plusieurs feuilles. (table = tableau structuré)

Devis : là où je saisis mon devis, infos client et produit

DataPrep : là où je garde mes tables de produits et autres afin de faire des RECHERCHEX dessus depuis la feuille Devis

Clients : table des clients

Analytics : je voudrais mettre sous forme de table les infos clés du devis (pour que je puisse analyser tous mes devis dans PQ) - cela fera peut-être l'objet d'un second poste.

Ce que je souhaite : une macro qui m'exporte uniquement la feuille Devis dans un dossier de mon choix, avec quelques régles pour le nommage du fichier. Le fichier doit être enregistré en .xlsx et surtout garder les mêmes couleurs que le fichier original. Enfin, je voudrais exécuter cette macro sur la feuille Devis via un bouton, mais je ne veux pas que le bouton apparaisse dans le nouveau fichier

Je me suis permis de chercher de l'aide chez chatGPT, mais rien ne remplace ce forum. Je vous joins le code (particulièrement pour le nommage du fichier) j'obtiens une erreur 1004, les couleurs ne sont pas conservés, et le bouton apparaît dans le nouveau fichier

Sub ExportQuoteSheet()
    Dim sourceWb As Workbook
    Dim targetWb As Workbook
    Dim ws As Worksheet
    Dim accountNumber As String
    Dim customerName As String
    Dim dateStr As String
    Dim fileName As String
    Dim filePath As String
    Dim tempFileName As String

    Set sourceWb = ThisWorkbook
    Set ws = sourceWb.Sheets("Quote")
    filePath = "C:\Users\XXX\XXX\XXX\XXX\" ' Change this to your desired folder path

    ' Define file name based on rules
    accountNumber = ws.Range("G3").Value
    customerName = ws.Range("B3").Value
    dateStr = Format(ws.Range("I2").Value, "DD.MM.YY")

    If accountNumber <> "CAS02" And accountNumber <> "VECTOR" Then
        fileName = " - " & accountNumber & " - " & dateStr & ".xlsx"
    ElseIf accountNumber = "CAS02" Then
        fileName = " - CAS02 - " & GetInitials(customerName) & " - " & dateStr & ".xlsx"
    ElseIf accountNumber = "VECTOR" Then
        fileName = "VECTOR - " & GetInitials(customerName) & " - " & dateStr & ".xlsx"
    End If

    ' Create a unique temporary file name
    tempFileName = "Temp_" & Format(Now, "yyyymmddhhmmss") & ".xlsx"

    ' Create a copy of the entire workbook
    sourceWb.SaveCopyAs filePath & tempFileName
    Set targetWb = Workbooks.Open(filePath & tempFileName)

    ' Break Links (if any)
    Dim link As Variant
    For Each link In targetWb.LinkSources(xlExcelLinks)
        targetWb.BreakLink name:=link, Type:=xlLinkTypeExcelLinks
    Next link

    ' Remove all sheets except "Quote"
    Application.DisplayAlerts = False
    For i = targetWb.Sheets.Count To 1 Step -1
        If targetWb.Sheets(i).name <> ws.name Then
            targetWb.Sheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True

    ' Save the new workbook as xlsx
    targetWb.SaveAs fileName:=filePath & fileName, FileFormat:=xlOpenXMLWorkbook
    targetWb.Close SaveChanges:=False

    ' Clean up temporary file
    Kill filePath & tempFileName
End Sub

Function GetInitials(name As String) As String
    Dim words() As String
    words = Split(name, " ")
    If UBound(words) >= 1 Then
        GetInitials = Left(words(0), 1) & Left(words(1), 1)
    Else
        GetInitials = Left(name, 2)
    End If
End Function

BONUS :J'ai voulu créer un fichier .xltm pour à chaque fois partir de 0, mais je pense que ça nous complique la vie, mais si vous avez une piste, je prends

Merci pour votre temps et votre contribution

Bonjour,

Vous qui savez si bien vous servir de l'iA, regardez donc en bas de cette page, il y a un bouton prévu...

Pour rechercher les mêmes sujets et donc les solutions

A+

Bonjour Bruno,

Je ne comprends pas votre réponse et en quoi elle contribue à la résolution de post.

Je ne connais pas si bien l'IA, sinon je ne serai pas là

Quant à la recherche des sujets similaires, oui j'ai recherché, mais cela ne m'a pas aidé à trouver la solution à mon problème, chaque challenge à ses subtilités et je cherche une aide sur mon problème, je n'ai pas beaucoup de connaissances en VBA

Merci pour votre aide

Re,

Le bouton indiqué vous permet d'afficher les réponses qui peuvent répondre à votre problématique

Vous pourriez trouver par exemple
https://forum.excel-pratique.com/excel/vba-exporter-la-feuille-active-au-format-xlsx-131981#p810506

Si vous regardez et testez le code de Ric, vous pourriez vous apercevoir qu'il fait ce que vous souhaitez

Et notamment cette partie

 With ActiveSheet
      .Copy
      With ActiveWorkbook
         .SaveAs Filename:=Destination & nf, FileFormat:=xlOpenXMLWorkbook
         .Close
      End With
   End With

Pour le bouton qui est un "shape" il suffit de faire la même chose pour trouver le bon code

Ensuite, concernant ces IA qui comme vous pouvez le voir n'apportent pas forcément les bonnes solutions
il est dommage d'aller la consulter et de venir sur ce forum ensuite, faute de solution.

Croyez moi, ça ne fait en général pas plaisir aux contributeurs

Bonne continuation

Bruno,

Merci pour votre retour. Par rapport à votre dernier point, ceci est votre interprétation. Considérez plutôt un autre angle plus tolérant. J’ai d’abord consulté l’IA pour ne pas abuser futilement du temps des contributeurs, ensuite cela peut me permettre d’apprendre ce que les contributeurs n’ont pas toujours le temps d’expliquer, enfin cela peut permettre aux contributeurs de résoudre plus vite un fil et puis d’aider un max de personnes, plutôt que de ne compter que sur eux et attendre les bras croisées.

Par rapport à mon problème, si vous avez lu mon post, mes connaissances en VBA se rapprochent de 0, donc un morceau de code n’est pas très utile pour moi, ensuite il y a la subtilité des couleurs, le code de l’IA effectue un certain export mais il conserve le bouton et que change la palette de couleurs ce qui ne me plait pas, et enfin il y a aussi ces conditions pour nommer le fichier de manière spécifique

Si vous avez l’amabilité de m’aider, je vous en remercie d’avance, vous pouvez vous aider du fichier

Excellent WE

Bonjour à tous

J'espère que vous avez passé d'excellentes fêtes de fin d'année. En espérant que cette année apporte plus de paix dans le monde.

Un petit up pour mon post, je reviens vers vous car j'ai vraiment besoin de votre aide

En vous remerciant par avance