Macro insertion valeur dans plusieurs cellules sélectionnées

Nash3390 Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
trotte-menu Messages postés 904 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour

je souhaiterais créer une macro me permettant d’insérer 1 valeur (exemple: M) dans plusieurs cellules que j’ai sélectionnées.

pour le moment j’ai réussi à créer la macro avec l’enregistreur pour insérer cette valeur dans une cellule uniquement.

pourriez-vous m’aider s’il vous plait?


merci

voici le code actuel:

sub M
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "StringName"
args1(0).Value = "M"

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args1())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "HorizontalAlignment"
args4(0).Value = com.sun.star.table.CellHoriJustify.CENTER

dispatcher.executeDispatch(document, ".uno:HorizontalAlignment", "", 0, 
args4())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "VerticalAlignment"
args5(0).Value = 2

dispatcher.executeDispatch(document, ".uno:VerticalAlignment", "", 0, 
args5())

rem ----------------------------------------------------------------------
dim args6(1) as new com.sun.star.beans.PropertyValue
args6(0).Name = "BackgroundColor.Color"
args6(0).Value = 15506340
args6(1).Name = "BackgroundColor.ComplexColorJSON"
args6(1).Value = "{ "+CHR$(34)+"ThemeIndex"+CHR$(34)+": -1, 
"+CHR$(34)+"Transformations"+CHR$(34)+": [ ]}"

dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, args6())

end sub


iPhone / Safari 18.6

2 réponses

  1. trotte-menu Messages postés 904 Date d'inscription   Statut Membre Dernière intervention   349
     

    Bonjour,

    j’ai réussi à créer la macro avec l’enregistreur

    Ton code utilise l’enregistreur UNO, qui n’est pas adapté pour agir sur plusieurs cellules à la fois.
    +1

    Rappel des limites de l'enregistreur de macro
    Dans l'aide F1 (Macros;enregistrement) : 
    Les actions suivantes ne sont pas enregistrées :
    * L'ouverture d'une fenêtre n'est pas enregistrée.
    * Les actions réalisées dans une fenêtre autre que celle dans laquelle l'enregistreur a été démarré ne sont pas enregistrées.
    * Le changement de fenêtre n'est pas enregistré.
    * Les actions indépendantes du contenu du document ne sont pas enregistrées. Par exemple, les modifications réalisées dans une boîte de dialogue d'options, l'organisateur de macros ou la personnalisation.
    * Les sélections sont enregistrées uniquement si elles sont réalisées en utilisant le clavier (déplacement du curseur)mais pas quand la souris est utilisée.
    * L'enregistreur de macro fonctionne uniquement dans Calc et Writer.


    2
  2. Bruno83200_6929 Messages postés 725 Date d'inscription   Statut Membre Dernière intervention   171
     

    Bonjour,

    Voici une version beaucoup plus simple et fonctionnelle de ta macro : elle insère la valeur "M" dans toutes les cellules sélectionnées, sans passer par le dispatcher.

    Ton code utilise l’enregistreur UNO, qui n’est pas adapté pour agir sur plusieurs cellules à la fois.
    Le plus simple est d’utiliser directement l’API Calc.

    Sub InsertMInSelection
        Dim oDoc As Object
        Dim oSel As Object
        Dim oCell As Object
        Dim oRange As Object
        
        oDoc = ThisComponent
        oSel = oDoc.getCurrentSelection()
        
        ' Si on a sélectionné un seul bloc
        If oSel.supportsService("com.sun.star.sheet.SheetCellRange") Then
            InsertIntoRange(oSel)
        
        ' Si on a une sélection multiple (Ctrl + clic)
        ElseIf oSel.supportsService("com.sun.star.sheet.SheetCellRanges") Then
            For Each oRange In oSel
                InsertIntoRange(oRange)
            Next oRange
        End If
    End Sub
    
    Sub InsertIntoRange(oRange As Object)
        Dim oCell As Object
        
        For Each oCell In oRange.Cells
            oCell.String = "M"                ' Insère la valeur
            oCell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
            oCell.VertJustify = com.sun.star.table.CellVertJustify.CENTER
            oCell.CellBackColor = 15506340    ' Exemple couleur
        Next oCell
    End Sub
    

    Pour chaque cellule sélectionnée :

    Remplit la cellule avec "M"

    Centre horizontalement et verticalement

    Applique la couleur de fond (même valeur que ton enregistreur)


    0