Macro : Problème CellAdress

fr-users
#1

Bonjour,

Je viens de mettre à jour ma version libre office en V7.1.5 et j'ai une macro qui fonctionnait dans les versions précédentes qui maintenant génère une erreur.
Dans un tableur je récupèrais le numéro de ligne du curseur avec l'instruction suivante :
    Numligne =    MonDocument.CurrentSelection.CellAddress.Row
Lors de l'éxécution de ma macro, j'ai maintenant le message de défaut suivant :Propriété ou méthode non trouvée : CellAddress.
En vérifiant avec XRAY (commande XRAY MonDocument.CurrentSelection) la propriété CellAdress n'apparait plus dans la liste. Par ou doit on passer maintenant?

#2

Bonjour François,

pour moi les instructions suivantes fonctionnent avec une Version 7.0.5.2

oMaSelectionneRFS=oDocumentAtraiterRFS.currentSelection
 oMaCelluleSelectionneRFS=oMaSelectionneRFS.CellAddress
 PositionDeLaLigneEnCoursRFS =oMaCelluleSelectionneRFS.row

de mémoire il me semble que j'avais décomposé les instructions pour vérifier à chaque fois que l'on a bien le bon objet sélectionné

car des fois j'ai eu des bizarrerie lié au classeur actif pas actif ....

Cordialement Jean-Luc

#3

Bonjour,
Celladdress n'est valable que si la sélection est une cellule.
Sinon il faut utiliser rangeaddress
Tu peux vérifier avec ce bout de code.
Claude

/sub RenvoiAdresse()//
//
//' feuille active colonne cellule active ligne cellule active//
//Dim document As Object//
//Dim feuille_active As Object//
//Dim cellule_active As Object//
//document = ThisComponent//
//feuille_active = document.currentController.activeSheet//
//'Ne fonctionne que si la sélection en cours est une cellule //
//if ThisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCell") then//
//        Dim c as integer//
//        cellule_active = document.getCurrentSelection//
//        'OOo travaille avec un index commençant à 0 : on ajoute donc + 1//
//        c = cellule_active.CellAddress.Column + 1//
//        r = cellule_active.CellAddress.Row + 1//
//        msgbox c  &", " &r//
//    else//
//        dim x as object//
//        x = document.getCurrentSelection.rangeaddress//
//        msgbox "début sélection colonne" & x.startcolumn+1 & ", ligne " &   x.startrow+1 & " fin sélection colonne " & x.endcolumn+1 & ", ligne " &x.endrow+1//
//
//end if//
//
//End sub/

#4

Je viens de ré-installer la version 7.1.5. Le dernier cas pour lequel cela ne fonctionne pas et renvoie une erreur est le cas d'une sélection de cellules non contiguës.
 A tester
/sub RenvoiAdresse()//
//
//' feuille active colonne cellule active ligne cellule active//
//Dim document As Object//
//Dim feuille_active As Object//
//Dim cellule_active As Object//
//document = ThisComponent//
//feuille_active = document.currentController.activeSheet//
//'Ne fonctionne que si la sélection en cours est une cellule //
//dim y as object//
//y = document.getCurrentSelection//
//if ThisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCell") then//
//        Dim c as integer//
//        cellule_active = document.getCurrentSelection//
//        'OOo travaille avec un index commençant à 0 : on ajoute donc + 1//
//        c = cellule_active.CellAddress.Column + 1//
//        r = cellule_active.CellAddress.Row + 1//
//        msgbox c  &", " &r//
//    else//
//        if ThisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCellRange") then//
//
//        dim x as object//
//        x = document.getCurrentSelection.rangeaddress//
//        msgbox "début sélection colonne" & x.startcolumn+1 & ", ligne " &   x.startrow+1 & " fin sélection colonne " & x.endcolumn+1 & ", ligne " &x.endrow+1//
//        else//
//        msgbox "non traité sélections multilples"//
//        end if//
//end if//
//
//End sub/

#5

Bonjour,
Cela fonctionne mais Il faudra perfectionner le code qui renvoie l'adresse de chaque cellule contenue dans une fusion. Dans le code ci-dessous, l'adresse de chaque cellule est renvoyée avec la zone de fusion.
Claude

option explicit

sub RenvoiAdresse()

' feuille active colonne cellule active ligne cellule active
Dim document As Object
Dim feuille_active As Object
Dim cellule_active As Object
document = ThisComponent
feuille_active = document.currentController.activeSheet
'Ne fonctionne que si la sélection en cours est une cellule
dim y as object
y = document.getCurrentSelection
if ThisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCell") then
        Dim c as integer
        cellule_active = document.getCurrentSelection
        'OOo travaille avec un index commençant à 0 : on ajoute donc + 1
        c = cellule_active.CellAddress.Column + 1
        r = cellule_active.CellAddress.Row + 1
        msgbox c  &", " &r
    else
        if ThisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCellRange") then

dim x as object
            dim cellule as object
            dim curseur as object
            dim i as double
            dim j as double
            x = document.getCurrentSelection.rangeaddress
            msgbox "début sélection colonne" & x.startcolumn+1 & ", ligne " &   x.startrow+1 & " fin sélection colonne " & x.endcolumn+1 & ", ligne " &x.endrow+1
            ' traitement de chauqe cellule
            for i =x.startcolumn to  x.endcolumn
                for j = x.startrow to  x.endrow
                 cellule = document.sheets(0).getcellbyposition(i,j)
                 curseur = document.sheets(0).createCursorByRange(cellule)
                 curseur.collapseToMergedArea
                 with curseur.RangeAddress
                     if .StartColumn <> .EndColumn or .StartRow <> .EndRow then
                         msgbox "cellule fusionnée " & curseur.AbsoluteName & chr(13) &_
                         "Col deb : " & .StartColumn & chr(13) &_
                         "Col fin : " & .EndColumn & chr(13) &_
                         "Lig deb : " & .StartRow & chr(13) &_
                         "Lig fin : " & .EndRow
                     else
                         msgbox "cellule normale "  & chr(13)  &_
                         "Col " & .StartColumn & chr(13) &_
                         "Lig " & .StartRow & chr(13)
                     endif
                 end with
             next j
            next i
        else
            msgbox "non traité sélections multilples"
        end if
end if

End sub