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

[RyuAutodidacte]

Bonjour,

j'ai beau chercher partout mais je ne trouve de solution pour le moment …

Comme l'onglet "Acceuil" qui existe dans le ruban, je cherche à pourvoir créer par vba un nouvel onglet "TOTO" et y insérer 4 macros, provenant d'un complément Excel d'un fichier xlam déjà insérer par macro :

Sub Add_AddIn() 'version Mac (peut être PC aussi pouvez vous confirmer SVP)
Dim addInPath As String
    addInPath = "MonChemin/TEST.xlam"
    AddIns.Add addInPath
    AddIns("TEST").Installed = True '
End Sub

Le but est de pourvoir faire une automatisation d'installation sur plusieurs utilisateurs Mac et PC

merci d'avance pour vos réponses

Ryu

 

[patricktoulon]

re

Sub Ouvrir()
Dim QuelFichier
    
    ChDir ThisWorkbook.Path
    QuelFichier = Application.GetOpenFilename(, , "Sélectionnez votre source de données")
    If QuelFichier <> False Then
        Debug.Print QuelFichier 'Workbooks.Open QuelFichier
    Else
        MsgBox "Vous n'avez pas sélectionné de fichier"
    End If
End Sub

 

[patricktoulon]

re

Sub BTOPENPROJECT_Cliquer()
    Dim myfile, x As Long, CsvCod, tbl, At, tblc, elem As ElementXml

    ThisWorkbook.Sheets("param").[h2:h3].ClearContents
    reset

    #If Mac Then
        On Error Resume Next
        MainPath = MacScript("POSIX path of (choose file with prompt ""Sélectionner un ou plusieurs fichiers:"" of type {""xls"",""pdf"",""xlsm"", ""csv""} with multiple selections allowed)")
        'Pour la partie => {""xls"",""pdf"",""xlsm""} mettre les extensions voulues, entourées de doubles guillemets et séparées par une virgule
        'Si on veut tous les fichiers mettre alors la double accolade comme suit => {}
        'Si on veut ne sélectionner qu'un fichier alors retirer => with multiple selections allowed
        If Err.Number > 0 Then MsgBox "Sélection annulée": Exit Sub
        On Error GoTo 0
        myfile = MainPath 'on récupère le tout dans un tableau de base 0 que l'on peut alors traiter
    #Else
        MsgBox "Mettre le code PC ici"
        With Application.FileDialog(msoFileDialogOpen)
            .InitialFileName = ThisWorkbook.Path
            If .Show = -1 Then
                myfile = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
    #End If




    With ThisWorkbook.Sheets("param")
        .[h2] = Mid(myfile, 1, InStrRev(myfile, Application.PathSeparator) - 1)
        .[H3] = Mid(myfile, InStrRev(myfile, Application.PathSeparator) + 1)
    End With
    x = FreeFile: Open myfile For Input As #x: CsvCod = Input$(LOF(x), #x): Close #x
    tbl = Split(CsvCod, vbCr)
    Set DocXml = New ElementXml
    DocXml.Id = "Document"
    At = Split(tbl(0), ";")
    For i = 1 To UBound(tbl)
        If Len(Trim(tbl(i))) > 3 Then
            tblc = Split(tbl(i), ";")
            If Trim(tblc(0)) = "" Then Set leParent = DocXml Else Set leParent = DocXml.getElementById(Id:=Trim(tblc(1)))
            Set MyElement = leParent.AddChildNode(Trim(tblc(2)))
            MyElement.Id = Trim(tblc(3))
            DoEvents
            For C = 4 To UBound(tblc)
                If tblc(C) <> "" Then MyElement.SetAttribute Trim(At(C)), Trim(tblc(C))
            Next
        End If
    Next
    visualAddAll

    Set customUI = DocXml.getElementById(Id:="customUI")
    IndentationShape


End Sub

 

[patricktoulon]

re fichier modifiée

 

[RyuAutodidacte]

Sub GetOpenFileNameMacRibbon() 'RyuAutodidacte 10/07/2024 - GetOpenFilename à ma sauce pour Mac
Dim myLocation As String
    myLocation = ThisWorkbook.Path & Application.PathSeparator
    If Application.OperatingSystem Like "*Macintosh*" Then
        On Error Resume Next
        MainPath = MacScript("POSIX path of (choose file with prompt ""Sélectionner du projet en .csv :"" of type {""csv""} default location " & Chr(34) & myLocation & Chr(34) & ")")
        If Err.Number > 0 Then MsgBox "Sélection annulée": Exit Sub
        On Error GoTo 0
    Else
        MsgBox "Mettre le code PC ici"
    End If
End Sub

 

[patricktoulon]

re

Sub BTOPENPROJECT_Cliquer()
    Dim myfile, x As Long, CsvCod, tbl, At, tblc, elem As ElementXml

    ThisWorkbook.Sheets("param").[h2:h3].ClearContents
    reset

    #If Mac Then
        On Error Resume Next
        Dim myLocation As String
        myLocation = ThisWorkbook.Path & Application.PathSeparator
        myfile = MacScript("POSIX path of (choose file with prompt ""Sélectionner du projet en .csv :"" of type {""csv""} default location " & Chr(34) & myLocation & Chr(34) & ")")
        If Err.Number > 0 Then MsgBox "Sélection annulée": Exit Sub
        On Error GoTo 0
    #Else
        With Application.FileDialog(msoFileDialogOpen)
            .InitialFileName = ThisWorkbook.Path
            If .Show = -1 Then
                myfile = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
    #End If

 

[RyuAutodidacte]

 

[RyuAutodidacte]

 

[patricktoulon]

 

[patricktoulon]

Bonjour @RyuAutodidacte
la dernière idée pour le ruban interface
les gallery ne sont pas encore faites et je n'ai pas tout mis
ce weekend j'ai pas eu un assez long moment pour finir
mais on voit bien déjà le fonctionnement des switch groupe

 

[RyuAutodidacte]

Franchement c'est pas trop mal, ca prends pas trop de place, c'est assez bien agencé
Peut etre faudrait il mettre un petite icone à coté/pour "Controls", "Attributs" et "Callbacks" pour que l'on voit bien et différencié chaque parties

 

[patricktoulon]

bon des icons maintenant au menu tree (tu n'en voulais pas au debut )
redonne moi la liste ou le lien des 200+ icons valables je vais faire les gallery j'ai un peu de temps ce matin

 

[RyuAutodidacte]

 

[patricktoulon]

 

[patricktoulon]

re

 

[RyuAutodidacte]