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

 

[RyuAutodidacte]

tu m'as posé des pièges :

 tb = Split("è,È,ê,Ê,î,Î,â,Â,ô,Ô,û,Û,ë,Ë,ï,Ï,ü,Ü,ç,Ç,æ,Æ,œ,Œ", ","): tb2 = Split("e,E,e,E,i,I,a,A,o,O,u,U,e,E,i,I,u,U,c,C,ae,AE,oe,OE", ",")

là c'est ok

 

[RyuAutodidacte]

Edit : j'ai rajouté le o dans le e ci-dessus

 

[patricktoulon]

et ben ? c'est ce que j'ai fait non ?

j'ai raté un épisode là

 

[RyuAutodidacte]

tb = Split("è,È,ê,Ê,î,Î,â,Â,ô,Ô,û,Û,ë,Ë,ï,Ï,ü,Ü,ç,Ç,æ,Æ", ","): tb2 = Split("e,E,e,E,o,I,a,A,p,O,u,U,e,E,i,I,u,U,c,C,ae,oe", ",")

oui en position 5 y a un î et on a un o en remplacment sans compter le p qui sort de je ne sais ou

 

[RyuAutodidacte]

re nouvelle version dis moi si c'est ok pour toi et vérifie qu'on bien les même numéro pour les les lettres :

À,à,Â,â,Ä,ä,Å,å,Æ,æ,Ç,ç,È,è,É,é,Ê,ê,Ë,ë,Ì,ì,Í,í,Î,î,Ï,ï,Ñ,ñ,Ò,ò,Ó,ó,Ô,ô,Ö,ö,œ,Œ,Ù,ù,Ú,ú,Û,û,Ü,ü,Ÿ,ÿ

203,136,229,137,128,138,129,140,174,190,130,141,233,143,131,142,230,144,232,145,237,147,234,146,235,148,236,149,132,150,241,152,238,151,239,153,133,154,207,206,244,157,242,156,243,158,134,159,217,216

A,a,A,a,A,a,A,a,AE,ae,C,c,E,e,E,e,E,e,E,e,I,i,I,i,I,i,I,i,N,n,O,o,O,o,O,o,O,o,oe,OE,U,u,U,u,U,u,U,u,Y,y

code test :

Sub test()
'    myStr = "àzért azèrtù dûçêçôœÀ"
    myStr = "À,à,Â,â,Ä,ä,Å,å,Æ,æ,Ç,ç,È,è,É,é,Ê,ê,Ë,ë,Ì,ì,Í,í,Î,î,Ï,ï,Ñ,ñ,Ò,ò,Ó,ó,Ô,ô,Ö,ö,œ,Œ,Ù,ù,Ú,ú,Û,û,Ü,ü,Ÿ,ÿ"
    tb = Split("203,136,229,137,128,138,129,140,174,190,130,141,233,143,131,142,230,144,232,145,237,147,234,146,235,148,236,149,132,150,241,152,238,151,239,153,133,154,207,206,244,157,242,156,243,158,134,159,217,216", ",")
    tb2 = Split("A,a,A,a,A,a,A,a,AE,ae,C,c,E,e,E,e,E,e,E,e,I,i,I,i,I,i,I,i,N,n,O,o,O,o,O,o,O,o,oe,OE,U,u,U,u,U,u,U,u,Y,y", ",")
    For i = 0 To UBound(tb): myStr = Replace(myStr, Chr(tb(i)), tb2(i)): Next
    Debug.Print myStr
End Sub

 

[RyuAutodidacte]

a tester
regarde si il y a un pb

 

[patricktoulon]

re

 

[patricktoulon]

re

 

[patricktoulon]

re

 

[RyuAutodidacte]

re

 

[patricktoulon]

re
voila le correctif pour ne plus écraser
vérifie ton script fileexists dans le scpt

Function RegMacCSVproject(csvcode)
    Dim Nom As String, folderAllproject As String, x As Long, fold, fich, RunMacScript As String, rewrite&
    If ThisWorkbook.Sheets("param").[h2] = "" Then
        rewrite = 0
        folderAllproject = ThisWorkbook.Path & Application.PathSeparator & "Mes Projets"
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "CreateFolder", folderAllproject)

        Nom = InputBox("Entrez un nom pour ce projet", "ouverture de nouveau projet", "myproject")
        If Nom = "Faux" Then Exit Function
        fold = folderAllproject & Application.PathSeparator & "Projet_" & Nom
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "CreateFolder", fold)

        fich = fold & Application.PathSeparator & Nom & ".csv"
        ThisWorkbook.Sheets("param").[h2] = fold
        ThisWorkbook.Sheets("param").[H3] = Nom & ".csv"

    Else
        rewrite = 2
        With ThisWorkbook.Sheets("param"): fich = .[h2] & Application.PathSeparator & .[H3]: End With
    End If

    If rewrite = 2 Then
        ' Kill fich
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "DeleteFile", fich)
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "CreateFileContentsUTF8", csvcode & "|" & fich)
    Else
        'If Dir(fich) <> "" Then MsgBox "un projet portant ce Nom exite deja": Exit Function
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "FileExists", fich)
        If RunMacScript = "true" Then
            MsgBox "un projet portant ce Nom exite deja"
            Set DocXml = Nothing
           clearvisual
           Exit Function
        End If
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "CreateFileContentsUTF8", csvcode & "|" & fich)
        MsgBox "Projet demarre"
    End If

End Function

 

[RyuAutodidacte]

j'ai vérifié le script FileExists, il est ok

 

[RyuAutodidacte]

C'est ok avec le nouveau code
par contre il garde en mémoire dan la feuille param :

ils ne sont pas à vide , on voit le chemin et le nom du projet

 

[RyuAutodidacte]

PS : tu peux effacer ces deux lignes

        ' Kill fich
        RunMacScript = AppleScriptTask("myScriptUI.scpt", "DeleteFile", fich)

 

[patricktoulon]

re

If RunMacScript = "true" Then
            MsgBox "un projet portant ce Nom exite deja"
            Set DocXml = Nothing
           clearvisual
          ThisWorkbook.Sheets("param").[H2:H3] = ""
          Exit Function
        End If