Microsoft 365 Charte Graphique vers Autocad

Sub CreerCharteGraphiqueAutoCAD()
    ' Déclaration des variables AutoCAD
    Dim acadApp As Object
    Dim acadDoc As Object
    
    ' Création d'une instance d'AutoCAD
    Set acadApp = CreateObject("AutoCAD.Application")
    
    ' Vérification si AutoCAD est en cours d'exécution
    If acadApp.Visible = False Then
        acadApp.Visible = True
    End If
    
    ' Création d'un nouveau document
    Set acadDoc = acadApp.Documents.Add
    
    ' Exemple : Création d'un calque et attribution d'une couleur
    Dim layer As Object
    Set layer = acadDoc.Layers.Add("MonCalque")
    layer.Color = 1 ' Remplacez par le code de couleur souhaité
    
    ' Exemple : Définition d'un type de ligne
    Dim lineType As Object
    Set lineType = acadDoc.Linetypes.Add("MonTypeLigne", "CONTINUOUS") ' Remplacez "CONTINUOUS" par le type de ligne souhaité
    
    ' Exemple : Assignation du type de ligne au calque
    layer.Linetype = "MonTypeLigne"
    
    ' Exemple : Autres opérations de configuration graphique...
    
    ' Fermeture d'AutoCAD
    acadApp.Quit
End Sub

Sub CreerCharteGraphiqueAutoCAD(acadDoc As Object, nomCalque As String, couleurCalque As Long, _
                                     typeLigne As String, epaisseurLigne As Double, Imprimable As Boolean)
    ' Exemple : Création d'un calque et attribution d'une couleur
    With acadDoc.Layers.Add(nomCalque)
        .Color = couleurCalque
        .Plot = Imprimable ' Définit le calque comme imprimable
        .Lineweight = epaisseurLigne ' Définit l'épaisseur de ligne
  
    ' Exemple : Définition d'un type de ligne
    Dim lineType As Object
    Set lineType = acadDoc.Linetypes.Add(nomCalque & "_" & typeLigne, typeLigne)
  
    ' Exemple : Assignation du type de ligne au calque
    .lineType = nomCalque & "_" & typeLigne
    End With
    ' Exemple : Autres opérations de configuration graphique...
End Sub

Sub test()
Dim i As Integer
With CreateObject("AutoCAD.Application")
    .Visible = True
    Dim acadDoc As Object
    Set acadDoc = .Documents.Open("C:\MyRep\MyDwg.dwg")
    With Sheets(1).Range("A1").CurrentRegion
        For i = 2 To .Rows.Count
            CreerCharteGraphiqueAutoCAD acadDoc, .Cells(i, "A"), .Cells(i, "B"), .Cells(i, "D"), .Cells(i, "E"), .Cells(i, "F") = "OUI"
        Next
    End With
   acadDoc.Save
   acadDoc.Close False
   .Quit
End With
End Sub