Macro insertion valeur dans plusieurs cellules sélectionnées

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. 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
    1. 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