Je vous la propose donc :
Code : Tout sélectionner
REM ****************************************
REM La macro ci-dessous permet la fusion,
REM verticale ou horizontale, d'une
REM sélection unique ou multiple.
REM Pour le forum francophone OpenOffice.org,
REM le 13.3.2009 - spYre
REM ****************************************
Option Explicit
Sub FusionElaboree
Dim oDoc as Object, oControl() as Object, oRange as Object, oRangeF as Object, o() as Object
Dim iChoix as Integer, iCount as Integer, i as Integer, j as Integer
oDoc = ThisComponent
oControl() = oDoc.GetCurrentSelection()
REM Dialogue élémentaire pour récupérer un choix (fusion verticale ou horizontale)
iChoix = MsgBox ( "OUI : fusion horizontale " & Chr( 13 ) & _
"NON : fusion verticale", 3 )
If iChoix = 2 Then 'Choix 'annuler'
Exit Sub
ElseIf oControl().ImplementationName = "ScCellRangeObj" Then 'Si la sélection est unique
iCount = 1
ElseIf oControl().ImplementationName = "ScCellRangesObj" Then 'Si la sélection est multiple
iCount = oControl().Count
Else print "Pourquoi vouloir fusionner une seule cellule ?" 'Si pas d'autre sélection que la cellule en cours
EndIf
For i = 0 to iCount-1 'Boucle sur chaque sélection
oRange = oControl(i).RangeAddress 'Mémorise l'adresse de la sélection
o() = Array( oRange.Sheet , oRange.StartColumn , oRange.StartRow , _
oRange.EndColumn , oRange.EndRow )
If iChoix = 6 Then
For j = o(2) to o(4) 'Boucle sur chaque ligne de la sélection pour une fusion horizontale
oRangeF = oDoc.Sheets.GetbyIndex(o(0)).GetCellRangebyPosition( o(1) , j , o(3) , j )
oRangeF.merge( false ) 'Pour éviter certains conflits avec des cellules éventuellement déjà fusionnées
oRangeF.merge( true )
Next j
Else For j = o(1) to o(3) 'Boucle sur chaque colonne de la sélection pour une fusion verticale
oRangeF = oDoc.Sheets.GetbyIndex(o(0)).GetCellRangebyPosition( j , o(2) , j , o(4) )
oRangeF.merge( false )
oRangeF.merge( true )
Next j
EndIf
Next i
End Sub