MACRO - Insertion cartouche depuis un template .CATDRAWING

Bonjour à tous,

Sur Catia v5 R18 je dois fais en sorte que sur mon nouveau fichier drawing je puisse insérer mon cartouche depuis un autre fichier .CATDRAWING qui sert de Template.
Pour ce faire on m'a envoyé une bibliothèque traitant ce sujet sauf que le cartouche Template n'est pas le bon et lorsque j'essaye de juste modifier dans le code afin d'utiliser mon fichier Template celui ci ne fonctionne plus.
Je vous mets ci joint la bibliothèque avec les codes VBA dans l'ordre (comme sur l'image) si quelqu'un à la solution ou une idée je suis preneur !

Code:

'==================================================================
' Extraire le chemin (parentPath) d'un fichier
'==================================================================
Public Function ExtraireChemin(fichier As String)
Dim Chaine As String
Dim iPass As Single
iPass = 0
Do While Left$(Chaine, 1) <> ""
Chaine = Right$(fichier, iPass)
iPass = iPass + 1
Loop
ExtraireChemin = Left$(fichier, Len(fichier) - Len(Chaine))
End Function

'==================================================================
' Selection d'un répertoire windows
'==================================================================
Public Function Choose_Path(message As String, Debut_Path As String)

Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, CStr(message), NO_OPTIONS, CStr(Debut_Path))
Set objFolderItem = objFolder.Self

Choose_Path = objFolderItem.Path

End Function
Public Function dec2frac(dblDecimal As Double) As String
'
'   Excel function to convert decimal values to integer fractions.
'
'   Written by:     Erik Oosterwal
'   Started on:     November 16, 2006
'   Completed on:   November 16, 2006
'

    Dim intNumerator, intDenominator, intNegative As Long   ' Declare integer variables as long
                                                            '   integers.
    Dim dblFraction, dblAccuracy As Double                  ' Declare floating point variables
                                                            '   as double precision.
    Dim txtDecimal As String                                ' need a string representation of the input value
                                                            ' in order to determine the required accuracy.
        
' Find the accuracy needed for the output by checking the number of digits behind the decimal point
'   of the input value.
'
'    dblAccuracy = 1 / 10 ^ (Len(CStr(dblDecimal - Fix(dblDecimal))) - 2)
'
'   While the formula above should work, there is a serious error in the way Excel handles
'   decimal numbers and there's a huge rounding error issue.  Subtracting the int() of
'   12.1 from 12.1 produces 0.0999999999 or something similar.  Obviously that won't
'   work for our desired accuracy of the magnitude of the fractional part of the number
'   so a slower more cumbersome method has to be used...
    
    dblAccuracy = 0.0001                                       ' Set the initial Accuracy level.
    txtDecimal = CStr(dblDecimal)                           ' Get a  string representation of the input number.
    
    For i = 1 To Len(txtDecimal)                                ' Check each character to see if it's a decimal point...
        If Mid$(txtDecimal, i, 1) = "." Then                    ' if it is then we get the number of digits behind the decimal
            dblAccuracy = 1 / 10 ^ (Len(txtDecimal) - i + 1)    '   assign the new accuracy level, and
            Exit For                                            '   exit the for loop.
        End If
    Next
    
    intNumerator = 0                                ' Set the initial numerator value to 0.
    intDenominator = 1                              ' Set the initial denominator value to 1.
    intNegative = 1                                 ' Set the negative value flag to positive.
    
    If dblDecimal < 0 Then intNegative = -1         ' If the desired decimal value is negative,
                                                    '   then set the negative value flag to
                                                    '   negative.
    
    dblFraction = 0                                 ' Set the fraction value to be 0/1.
        
    While Abs(dblFraction - dblDecimal) > dblAccuracy   ' As long as we're still outside the
                                                        '   desired accuracy, then...
        If Abs(dblFraction) > Abs(dblDecimal) Then      ' If our fraction is too big,
            intDenominator = intDenominator + 1         '   increase the denominator
        Else                                            ' Otherwise
            intNumerator = intNumerator + intNegative   '   increase the numerator.
        End If
        
        dblFraction = intNumerator / intDenominator     ' Set the new value of the fraction.
        
    Wend

    dec2frac = LTrim(Str(intNumerator)) & ":" & LTrim(Str(intDenominator)) ' Display the numerator and denominator
    
End Function
'==================================================================
' Selection de fichier excel
'==================================================================
Public Function Excel_Path(ObjExcel)

Dim strPathExcel, strCN
Dim objFile, strGuyFile, intRow

intRow = 1
Set ObjExcel = CreateObject("Excel.Application")

    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    objDialog.Filter = "Excel Files|*.xls|All Files|*.*"
    objDialog.FilterIndex = 1
    intResult = objDialog.ShowOpen

    If intResult = 0 Then
        Exit Function
    End If

strPathExcel = objDialog.FileName

ObjExcel.Workbooks.Open strPathExcel
Set Excel_Path = ObjExcel.ActiveWorkbook.Worksheets(1)

End Function

Public Function Is_ActiveDocument_CATIAFile() As Boolean
    Is_ActiveDocument_CATIAFile = False
    Err.Clear
    On Error Resume Next
        If TypeName(CATIA.ActiveDocument) = "PartDocument" Or TypeName(CATIA.ActiveDocument) = "ProductDocument" Or TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then Is_ActiveDocument_CATIAFile = True
        If Err.Number <> 0 Then Is_ActiveDocument_CATIAFile = False
    On Error GoTo 0
End Function

Public Function Is_ActiveDocument_Draw() As Boolean
    Is_ActiveDocument_Draw = False
    Err.Clear
    On Error Resume Next
        If TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then Is_ActiveDocument_Draw = True
        If Err.Number <> 0 Then Is_ActiveDocument_Draw = False
    On Error GoTo 0
End Function

Public Function Is_ActiveDocument_Part() As Boolean
    Is_ActiveDocument_Part = False
    Err.Clear
    On Error Resume Next
        If TypeName(CATIA.ActiveDocument) = "PartDocument" Then Is_ActiveDocument_Part = True
        If Err.Number <> 0 Then Is_ActiveDocument_Part = False
    On Error GoTo 0
End Function

Public Function Is_ActiveDocument_Product() As Boolean
    Is_ActiveDocument_Product = False
    Err.Clear
    On Error Resume Next
        If TypeName(CATIA.ActiveDocument) = "ProductDocument" Then Is_ActiveDocument_Product = True
        If Err.Number <> 0 Then Is_ActiveDocument_Product = False
    On Error GoTo 0
End Function

Public Function ExtraireNomFichier(Path As String) As String
ExtraireNomFichier = Right(Path, Len(Path) - InStrRev(Path, ""))
End Function

Public Sub CartoucheCopy(MyFormat As String)
Dim Mydocuments As Documents
Dim MyCartoucheDraw As DrawingDocument
Dim MyCartoucheSheets As DrawingSheets, MyCartoucheSheet As DrawingSheet, MyCartoucheViews As DrawingViews, MyCartoucheBackgroundView As DrawingView
Dim MyNum As Integer, i As Integer

Dim MySourceSelection As Selection, MyCibleSelection As Selection

Set Mydocuments = CATIA.Documents

Select Case MyFormat
    Case "A3"
        MyNum = 4
        MySheet.PaperSize = catPaperA3
    Case "A2"
        MyNum = 3
        MySheet.PaperSize = catPaperA2
    Case "A1"
        MyNum = 2
        MySheet.PaperSize = catPaperA1
    Case "A0"
        MyNum = 1
        MySheet.PaperSize = catPaperA0
    Case "2A0"
        MyNum = 5
        MySheet.PaperSize = catPaperUser
        MySheet.SetPaperHeight (841)
        MySheet.SetPaperWidth (2378)
    Case "3A0"
        MyNum = 6
        MySheet.PaperSize = catPaperUser
        MySheet.SetPaperHeight (841)
        MySheet.SetPaperWidth (3567)
End Select

Set MyCartoucheDraw = Mydocuments.Open(CartoucheDrawing)

Mydrawing.Activate

Set MySourceSelection = MyCartoucheDraw.Selection

Set MyCartoucheSheets = MyCartoucheDraw.Sheets
Set MyCartoucheSheet = MyCartoucheSheets.Item(MyNum)

Set MyCartoucheViews = MyCartoucheSheet.Views

For i = 1 To MyCartoucheViews.Count
    If InStr(MyCartoucheViews.Item(i).Name, "Background") <> 0 Then
        Set MyCartoucheBackgroundView = MyCartoucheViews.Item(i)
        Exit For
    End If
Next i

MyCartoucheBackgroundView.Activate

'Méthode gardant les éléments du calque de fond draw cible
'For Each MyItemElmts In MyCartoucheBackgroundView.GeometricElements
'    MySourceSelection.Add MyItemElmts
'Next MyItemElmts
'
'For Each MyItemText In MyCartoucheBackgroundView.Texts
'    MySourceSelection.Add MyItemText
'Next MyItemText

'Méthode supprimant les éléments du calque de fond draw cible
MySourceSelection.Add MyCartoucheBackgroundView.GeometricElements
MySourceSelection.Add MyCartoucheBackgroundView.Texts
MySourceSelection.Add MyCartoucheBackgroundView.Pictures

MySourceSelection.Copy

Set MyCibleSelection = Mydrawing.Selection

MyCibleSelection.Clear

Mydrawing.Activate

MyCibleSelection.Add MySheet

MyCibleSelection.Paste

CATIA.ActiveWindow.ActiveViewer.Reframe

MyCartoucheDraw.Close

End Sub

Public Function SheetCount(MySheets As DrawingSheets) As Integer 'Compte le nb total de calque(s) du draw (excepté calque de détails)

Dim nbSheet As Integer
Dim MySheet

For Each MySheet In MySheets
    If MySheet.IsDetail Then 'Test si le calque scanné est un calque de détail
    Else
    nbSheet = nbSheet + 1
    End If
Next

SheetCount = nbSheet

End Function

Public Sub ImportationCartoucheIngeliance()

Select Case MySheet.PaperSize
    Case catPaperA3
        CartoucheCopy ("A3")
    Case catPaperA2
        CartoucheCopy ("A2")
    Case catPaperA1
        CartoucheCopy ("A1")
    Case catPaperA0
        CartoucheCopy ("A0")
    Case Else
        If MySheet.GetPaperHeight = 841 And MySheet.GetPaperWidth = 2378 Then
            CartoucheCopy ("2A0")
        ElseIf MySheet.GetPaperHeight = 841 And MySheet.GetPaperWidth = 3567 Then
            CartoucheCopy ("3A0")
        Else
            MsgBox "Format calque non compatible", vbExclamation
        End If
End Select

End Sub


Code:

Option Explicit

Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As Long
Private Declare PtrSafe Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As String) As Long
Private Declare PtrSafe Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As LongPtr, ByVal bInheritHandle As LongPtr, ByVal dwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As LongPtr, ByVal lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flAllocationType As Long, ByVal flProtect As LongPtr) As LongPtr
Private Declare PtrSafe Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As LongPtr, lpAddress As Any, ByVal dwSize As LongPtr, ByVal dwFreeType As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As LongPtr, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As LongPtr, lpNumberOfBytesWritten As LongPtr) As Long
Private Declare PtrSafe Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As LongPtr, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As LongPtr, lpNumberOfBytesWritten As LongPtr) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_CLOSE = &H10
Private Const HDM_GETITEMCOUNT = (&H1200 + 0)
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEM As Long = (LVM_FIRST + 5)
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45
Private Const LVIS_SELECTED = &H2
Private Const LVIF_TEXT = &H1
Private Const LVIF_STATE = &H8&
Private Const PAGE_READWRITE = &H4&
Private Const MEM_RESERVE = &H2000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private F_hwnd As LongPtr 'Forma
Private L_hwnd As LongPtr 'Lista
Private iLinks As New Collection

Private Type LVITEM
mask As LongPtr
iItem As Long
iSubitem As Long
state As Long
stateMask As Long
pszText As LongPtr
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type

Private ListCount As Integer

Public Function GetV5Links() As Collection
CATIA.StartCommand ("Liens...")
CATIA.RefreshDisplay = True
F_hwnd = FindWindowLike("Liens du document")
ShowWindow F_hwnd, SW_HIDE
Sleep 100
EnumChildWindows F_hwnd, AddressOf EnumChildWindow, 0
Dim Rows, Cols, CrtR As Integer
Rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0)
Rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0)
Dim RetColl As New Collection

For CrtR = 0 To Rows - 1
Dim lItem As New LinkItem
lItem.DocumentPointe = ListViewGetText(CrtR, 0)
lItem.StatutDoc = ListViewGetText(CrtR, 1)

RetColl.Add lItem
Set lItem = Nothing
Next

ShowWindow F_hwnd, SW_SHOW
SendMessageAny F_hwnd, WM_CLOSE, 0, 0
Set GetV5Links = RetColl
End Function

Private Function EnumChildWindow(ByVal hChild As LongPtr, ByVal lParam As LongPtr) As Long
Dim iClass As String
Dim iText As String
Dim j As Integer

ListCount = 0

iClass = Space(512)
j = GetClassName(hChild, iClass, 63)
iClass = Left(iClass, j)
iText = Space(512)
j = SendMessageStr(hChild, WM_GETTEXT, 512, iText)
iText = Left(iText, j)
If iClass = "SysListView32" Then
ListCount = ListCount + 1
If ListCount = 1 Then
L_hwnd = hChild: EnumChildWindow = 0: Exit Function
End If
End If
EnumChildWindow = 1 ' Continua enumerarea
End Function

Private Function FindWindowLike(strPartOfCaption As String) As LongPtr
Dim hwnd As LongPtr
Dim strCurrentWindowText As String
Dim r As Integer
hwnd = GetForegroundWindow
Do Until hwnd = 0
strCurrentWindowText = Space$(512)
r = GetWindowText(hwnd, strCurrentWindowText, 512)
strCurrentWindowText = Left$(strCurrentWindowText, r)
If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
Exit Function
Found:
FindWindowLike = hwnd
End Function

Private Function ListViewGetText(ByVal Ligne As Long, ByVal Colonne As Long) As String
Dim lngProcID As LongPtr, lngProcHandle As LongPtr
Dim typLvItem As LVITEM, strLvItem As String
Dim lngVarPtr1 As LongPtr, lngVarPtr2 As LongPtr
Dim lngMemVar1 As LongPtr, lngMemVar2 As LongPtr
Dim lngMemLen1 As LongPtr, lngMemLen2 As LongPtr

Call GetWindowThreadProcessId(L_hwnd, lngProcID)
If lngProcID <> 0 Then
lngProcHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lngProcID)
If lngProcHandle <> 0 Then
strLvItem = String(512, vbNullChar) 'Space$(512) String(512, vbNullChar)
lngVarPtr1 = StrPtr(strLvItem)
lngVarPtr2 = VarPtr(typLvItem)
lngMemLen1 = LenB(strLvItem)
lngMemLen2 = LenB(typLvItem)
lngMemVar1 = VirtualAllocEx(lngProcHandle, 0, lngMemLen1, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
lngMemVar2 = VirtualAllocEx(lngProcHandle, 0, lngMemLen2, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
With typLvItem
.cchTextMax = 255
.iItem = Colonne
.iSubitem = Ligne
.mask = LVIF_TEXT
.pszText = lngMemVar1
End With
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar2, ByVal lngVarPtr2, lngMemLen2, 0)
Call SendMessageAny(L_hwnd, LVM_GETITEMTEXT, Ligne, ByVal lngMemVar2)
Call ReadProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
strLvItem = StrConv(strLvItem, vbUnicode)
strLvItem = Left(strLvItem, InStr(1, strLvItem, vbNullChar) - 1)
ListViewGetText = strLvItem
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar1, lngMemLen1, MEM_RELEASE)
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar2, lngMemLen2, MEM_RELEASE)
Call CloseHandle(lngProcHandle)
End If
End If
End Function


Function RECUP_LIENS(MyExportFileName As String)
Dim MyLinksCol As New Collection

If Is_ActiveDocument_CATIAFile Then
    Set MyLinksCol = iLink.GetV5Links
    ExportCollection MyLinksCol, MyExportFileName

Else
    MsgBox "Document non supporté!", vbExclamation
Exit Function
End If
End Function

Function ExportCollection(MyCollection As Collection, MyExportFileName As String)
Dim MyItem As LinkItem
Dim MyCurrentLine As String
Dim oFSO As Scripting.FileSystemObject
Dim oTxt As Scripting.TextStream

Set oFSO = New Scripting.FileSystemObject
Set oTxt = oFSO.CreateTextFile(Environ("temp") & "\" & MyExportFileName & ".txt", True, True)

oTxt.writeline "Document;Statut"

For Each MyItem In MyCollection
    MyCurrentLine = MyItem.DocumentPointe & ";"
    MyCurrentLine = MyCurrentLine & MyItem.StatutDoc
    oTxt.writeline MyCurrentLine
Next

oTxt.Close

End Function
Sub main()
RECUP_LIENS "Test"
End Sub


Code:

Option Explicit
Public MyDrawType As String
Public MyReference As String, MyTitre As String, MyRevision As String
Public MyAuteur As String, MyVerifie As String, MyApprouve As String
Public MyDateAuteur As String, MyDateVerifie As String, MyDateApprouve As String
Public MyEchelle As String, MyRugosite As String, MyMasse As String, MyDimTol As String, MyGeoTol As String, MyFormat As String, MyPlanche As String
Public MyMatiere As String, MyTraitementSurface As String
Public MyLinkedDocCol As Collection

Public Mydrawing As DrawingDocument, MySheets As DrawingSheets, MySheet As DrawingSheet, MyViews As DrawingViews, MyBackgroundView As DrawingView
Public MyBackgroundTexts As DrawingTexts

Public Const NomFichierIni = "InfosING.ini"
Public Const CartoucheDrawing = "H:\DONNEES\07_PRODUCTION\1 - BE MECA\z_Config\CatiaV52018\Template.CATDrawing"
Public Setting_Path As String

Sub CATMain()

Setting_Path = Environ("CATUserSettingPath") & "\"

If CATIA.Windows.Count = 0 Then
    MsgBox "Veuillez ouvrir un document draw avant de lancer la macro", vbInformation
    Exit Sub
End If

If Not TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then
    MsgBox "Veuillez afficher un draw actif dans la fenêtre en cours avant de lancer la macro", vbInformation
    Exit Sub
End If

Set Mydrawing = CATIA.ActiveDocument
Set MySheets = Mydrawing.Sheets
Set MySheet = MySheets.ActiveSheet
Set MyViews = MySheet.Views

Mydrawing.Selection.Clear

Dim i As Integer
For i = 1 To MyViews.Count
    If InStr(MyViews.Item(i).Name, "Background") <> 0 Then
        Set MyBackgroundView = MyViews.Item(i)
        Set MyBackgroundTexts = MyBackgroundView.Texts
        If MyBackgroundTexts.Count = 0 Then
'            MsgBox "Veuillez créer un cartouche INGELIANCE avant de lancer la macro", vbInformation
            ImportationCartoucheIngeliance
            Exit Sub
        Else
            MyDrawType = DetectionTypeCartouche(MyBackgroundTexts)
            If MyDrawType = "AUCUN" Then
'                MsgBox "Cartouche du draw incompatible avec la macro", vbInformation
                ImportationCartoucheIngeliance
                Exit Sub
            End If
            
            Dim View As DrawingView
            For Each View In MyViews
                If View.IsGenerative Then
                    RECUP_LIENS "DocumentsCatiaLies"
                    Exit For
                End If
                EmptyLinks "DocumentsCatiaLies"
            Next View
            
            Infos_ING_Form.Show
            
        End If
    End If
Next i

End Sub

Public Function DetectionTypeCartouche(MyBackgroundTexts As DrawingTexts) As String

Dim j As Integer
For j = 1 To MyBackgroundTexts.Count
    With MyBackgroundTexts.Item(j)
        If .Name = "tbi_planche" Then
            DetectionTypeCartouche = "CARTOUCHE_ING"
            Exit Function
        End If
    End With
Next j

DetectionTypeCartouche = "AUCUN"

End Function

Public Function EmptyLinks(MyExportFileName As String)
Dim MyFSO As Scripting.FileSystemObject
Dim MyTxt As Scripting.TextStream

Set MyFSO = New Scripting.FileSystemObject
Set MyTxt = MyFSO.CreateTextFile(Environ("temp") & "\" & MyExportFileName & ".txt", True, True)

MyTxt.writeline "Document;Statut"

MyTxt.Close
End Function

Public Function ImportLinkedDocs(MyCollectionToFill As Collection, MyImportFileName As String)

Dim MyCurrentLine() As String
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(Environ("temp") & "\" & MyImportFileName & ".txt")
Set oTxt = oFl.OpenAsTextStream(ForReading, TristateTrue)
With oTxt
    While Not .AtEndOfStream
        MyCurrentLine() = Split(.ReadLine, ";")
        Dim MyItem As New LinkItem
        MyItem.DocumentPointe = MyCurrentLine(0)
        MyItem.StatutDoc = MyCurrentLine(1)
        Set MyItem = Nothing
        MyCollectionToFill.Add MyItem
    Wend
End With

MyCollectionToFill.Remove MyCollectionToFill.Count

End Function



Merci d'avance et s'il y a besoin de plus d'explicatio, images ou autres hésitez pas à me le dire.

Résolu il fallait que les cartouches de mon nouveau Template soit en fond de calque tout simplement.

Maintenant, je voudrais créer un UserForm me permettant de remplir manuellement mon cartouche mais aussi via un bouton "Importer du 3D" importer tous les éléments déja présents dans le 3D (Reference,Nomenclature,etc).

SI quelqu'un s'y connait en UserForm je suis preneur s'il vous plait.