Microsoft 365 Création d'un nouvel onglet du ruban en vba et y attacher 4 macros complémentaires (MAC et PC)

#If Mac Then
    'Private Declare PtrSafe Function CopyMemory_byVar Lib "libc.dylib" Alias "memmove" (ByRef dest As Any, ByRef src As Any, ByVal size As Long) As LongPtr
    #If Win64 Then
        'Private Declare PtrSafe Function CopyMemory_byPtr Lib "libc.dylib" Alias "memmove" (ByVal dest As LongPtr, ByVal src As LongPtr, ByVal size As Long) As LongPtr
        Private Declare PtrSafe Function CopyMemory_byVar Lib "libc.dylib" Alias "memmove" (ByRef dest As Any, ByRef src As Any, ByVal size As Long) As LongPtr
    #Else
        'Private Declare Function CopyMemory_byPtr Lib "libc.dylib" Alias "memmove" (ByVal dest As Long, ByVal src As Long, ByVal size As Long) As Long
        Private Declare Function CopyMemory_byVar Lib "libc.dylib" Alias "memmove" (ByRef dest As Any, ByRef src As Any, ByVal size As Long) As Long
    #End If
#Else
    #If VBA7 Then
        Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                                   ByRef Source As Any, _
                                                   ByVal Length As Long)
    #Else
        Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                           ByRef Source As Any, _
                                           ByVal Length As Long)
    #End If
#End If

'procedure {onAction} du bouton [ID:''button_1'' Label:''Change size'']'dans le parent [groupattribut'' Label:''LES ATTRIBUTS'']
Sub ChangeAttribut(control As IRibbonControl)
    Dim s As String, T As String, def As String, newdef As String, tsuptip$
    If DocXml Is Nothing Then MsgBox "La variable docXml est vide veuillez redemerer le projet": Exit Sub
    T = control.Tag
    If T = "supertip" Then tsuptip = vbCrLf & "Pour les saut de ligne utilisez le caratre""|"""
    If T = "sizeString" Then tsuptip = vbCrLf & "Un ediBox se dimensionne par une chainne de caracteres" & vbCrLf & _
    "tapez le nombre de caractères" & vbCrLf & "exemple :20 pour 20 caracteres de largeur"
    Set MyElement = DocXml.getElementById(id:=[c3].Value)
    If Not MyElement Is Nothing Then
        If Not DocXml.AdmissibleAttribut(T, MyElement) Then MsgBox "Cet attributs n'est pas admissible pour cet element ou dans son contexte": Exit Sub
        Select Case T
            Case "size", "itemSize": s = Mid(control.id, 1, Len(control.id) - 1)
                If s = "large" Then MyElement.SetAttribute T, s Else MyElement.RemoveAttribute (T)
            Case "boxStyle": s = Mid(control.id, 1, Len(control.id) - 1)
                MyElement.SetAttribute T, s:
            Case Else:
                def = MyElement.GetAttribute(T)
                 newdef = InputBox("changez l'attribut : " & T & tsuptip, "Modifier un attribut", def)
                If T = "sizeString" Then If Val(newdef) > 0 Then newdef = String(Val(newdef), "z")
               If newdef <> "" Then
                    MyElement.SetAttribute T, newdef
                    If T = "label" Then
                        Sheets("interface").DrawingObjects(MyElement.id).Text = "[" & MyElement.tagname & "] " & MyElement.GetAttribute("label")
                        If MyElement.tagname = "item" Then
                            Sheets("interface").DrawingObjects(MyElement.id).Name = newdef
                            MyElement.id = Replace(newdef, " ", "_")
                        End If
                        If MyElement.tagname = "button" Then
                            MyElement.SetAttribute "tag", newdef
                        End If
                    End If
                    Else: MyElement.RemoveAttribute (T)
                End If
        End Select
    End If
    miseAjourTableAttribut MyElement
End Sub

Sub test()
    Dim resultat$
    Dim FolderCustomUI$
    Dim arguments$
    Dim fichier$
    dim sep
sep=application.pathseparator
' Définir le chemin complet et le contenu du fichier
    FolderCustomUI = ThisWorkbook.Path & sep & "customUI"
    fichier = "customUI14.xml"

    ' Créer la chaîne d'arguments pour le script AppleScript
    arguments = cheminFichier& & sep & fichier & "," & docxml.generatexml

    ' Appeler le script AppleScriptTask
    resultat = AppleScriptTask("myScriptUI.scpt", "CreateFolder", FolderCustomUI)
    resultat = AppleScriptTask("myScriptUI.scpt", "CreateXml", arguments)
    ' Afficher le résultat
    MsgBox resultat
End Sub

on createfile(arguments)
    -- Diviser la chaîne d'arguments en composantes
    set AppleScript's text item delimiters to ","
    set argsList to text items of arguments

    set filePath to item 1 of argsList
    set fileContent to item 2 of argsList

    try
        set fileRef to open for access POSIX file filePath with write permission
        set eof of fileRef to 0 -- Réinitialiser le fichier
        write fileContent to fileRef starting at eof
        close access fileRef
        return "Fichier créé avec succès à " & filePath
    on error errMsg number errNum
        try
            close access POSIX file filePath
        end try
        return "Erreur: " & errMsg
    end try
end createfile