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 939 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

 

A voir également:

2 réponses

trotte-menu Messages postés 939 Date d'inscription   Statut Membre Dernière intervention   321
 

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.


1
Bruno83200_6929 Messages postés 667 Date d'inscription   Statut Membre Dernière intervention   156
 

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