Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

RyuAutodidacte

XLDnaute Impliqué
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 :
VB:
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

XLDnaute Barbatruc
VB:
#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
 

RyuAutodidacte

XLDnaute Impliqué
Re,
j'ai oublié qq ch
vois si il est possible de faire qq ch, car quand je cache tous les onglets habituels, sur mac j'en ai apparement qq uns supplémentaires :
  • Dessin
  • Affichage
  • Automatisation
A moins que j'ai merdé qq part … tu me le diras …
voilà les éleménts :




PS : dis moi si il est possible de mettre un message d'indication en supp de comment remplir l'attribut ou le callback cliqué dans le inputBox car ce n'est pas forcément évident (exemple du sizeString, si qq un ne connait pas il ne saura pas quoi faire pour le faire correctement (qui est l'un cas des plus simple))
 

Pièces jointes

  • Sample.xlsm
    13.3 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
re


VB:
'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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
pour cacher les autres onglets sup il faudrait que tu regarde d"ans officeui
fait en un à la main et voit le nom qu'ils ont
si il sont pas dans la liste alors c'est des complements non accessibles
tu dois les voir ici
 

patricktoulon

XLDnaute Barbatruc
j'ai penser a un truc comme ça pour les fichiers
vba
VB:
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

dans le scpt
terminé et normalement on est en iso puisque l'on converti pas

Code:
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
 

patricktoulon

XLDnaute Barbatruc
re
heu.... alors j'ai extrait le customUI de l'archive Ansi
tu délire ou quoi?
1 il n'est pas en Ansi
2 si tu enregistre en Ansi tu change le procces


mais ne te casse pas la tête avec ça j'ai tout remis en UTF-8 chez moi pour m'aligner a Mac
j'ai modifier ma partie window j'ai mis ma sub perso plus complète pour le utf-8
sinon on va pas s'en sortir
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…