System-9

特定のセルをダブルクリックしたらマクロ起動

特定のセルに対しては、特別な入力規則や選択肢を提示するようにしたい場合があります。
LibreOffice Calcでは、シート名タブを右クリック→シートイベント(V) で表示される「アクションの割り当て」ダイアログで、ダブルクリックしたときや内容を変更したときなどに起動するマクロを指定できます。この指定はシート単位で有効です。

fig

「アクションの割り当て」ダイアログ

特定のセルのみに対して実行するためには、マクロ中でセルの判別を行います。ここでは背景色によって切り替えを行っています。赤系統の色ならば、ダブルクリックしたセルの位置をメッセージボックスで表示し、それ以外の背景色ならば何もせずにマクロを終了します。
セルの色を調べるためのGetRGBsepalately、選択されたセルの列番号を取得するGetColumnOfSelectedCell、選択されたセルの行番号を取得するGetRowOfSelectedCellといったFunctionを使っています。これらはいずれも前出です。
なお、「アクションの割り当て」ダイアログで「選択を変更したとき」にマクロを指定すると、セルクリック後はマウスボタンを押していないのにドラッグ状態になるためうまくいきません。 Calcの不具合でしょうか(バージョン: 4.1.1.2)。

画像は、セルC5をダブルクリックしたときのメッセージボックス表示例です。背景が白のセルをダブルクリックしても何も起こりません。事前に「アクションの割り当て」を「ダブルクリックしたとき」でこのマクロeventTest()に設定しておきます。

fig

Double Click Ivent Action

Kom., 2013

<< SDメモリUSBメモリ激安　上海問屋 >>

Sub eventTest()
    ' Kom. 2013
    ' To be invoked on Double Clicking a Cell.
    Dim oDoc As Object
    Dim oSheet As Object
    Dim oSel As Object
    Dim red As Integer, blue As Integer, green As Integer
    Dim sCellPos As String
    
    oDoc = ThisComponent
    'Get the active sheet for this procesure.
    oSheet = oDoc.getCurrentController.getActiveSheet()
    oSel = oDoc.CurrentController.getSelection() 

    'If current selection is not single cell, quit this Sub.
    if  not (oSel.ImplementationName = "ScCellObj") then
        Exit Sub
    End If

    'Get red, green and blue components separately from Backcolor of the cell.
    red = GetRGBsepalately(oSel.CellBackColor, 0)
    green = GetRGBsepalately(oSel.CellBackColor, 1)
    blue = GetRGBsepalately(oSel.CellBackColor, 2)     

    'If the backcolor is close to Red, display the position of the cell on a MessegeBox.
    if (red >= 200) And (green < 10) And (blue < 10)  then
        sCellPos=CStr(GetColumnOfSelectedCell(oDoc)) & "," & CStr(GetRowOfSelectedCell(oDoc))
        MsgBox(sCellPos)
    EndIf
End Sub

Function GetRGBsepalately(rgb as Long, cid as integer) as integer
    'cid  0:red,  1:green  2:blue
    Dim wk as Long
    
    if cid=0 then 'Red
        wk = rgb AND &HFF0000
        wk = wk /&H10000
        GetRGBsepalately = wk
    elseif cid=1 then
        wk = rgb AND &H00FF00
        wk = wk /&H100
        GetRGBsepalately = wk
    elseif cid=2 then
        wk = rgb AND &H0000FF
        GetRGBsepalately = wk
    else
        GetRGBsepalately = -1
    end if
End Function

Function GetRowOfSelectedCell(oDc as Object)  as Long
    Dim oSel as Object 
    Dim oCellAddr as Object 
    Dim nActCol as Long, nActRow as Long 
    Dim nShtNo as Integer 
    oSel = oDc.CurrentController.getSelection() 
    oCellAddr = oSel.getCellAddress() 
    oActCol = oCellAddr.Column 
    nActRow = oCellAddr.Row 
    GetRowOfSelectedCell=nActRow
End Function

Function GetColumnOfSelectedCell(oDc as Object)  as Long
    Dim oDoc as Object 
    Dim oSel as Object 
    Dim oCellAddr as Object 
    Dim nActCol as Long, nActRow as Long 
    Dim nShtNo as Integer 
    oSel = oDc.CurrentController.getSelection() 
    oCellAddr = oSel.getCellAddress() 
    nActCol = oCellAddr.Column 
    GetColumnOfSelectedCell=nActCol
End Function

OpenOfficeマクロプログラミング―「Writer」「Calc」「Base」…OOoをBasicで便利に! (I・O BOOKS)

Lenovo ノートPC ThinkPad

iLEDについて

Javaサンプル

Netbeans

Libre Office Basicマクロ

その他

特定のセルをダブルクリックしたらマクロ起動