System-9

選択されているセルの背景色の取得

LibreOffice Calcでの背景色の取得をBasicで行ってみます。背景色は32ビットLong型整数で得られます。 R,G,Bのそれぞれの値が8ビットずつ詰め込まれています。それぞれの色成分を取り出すには、ビット演算を行います。
また、選択セルの取得時に、選択は単独セルで行われているかチェックしています。
実行すると、メッセージボックスに 255-255-0 のような形でR,G,Bのそれぞれの値を表示し、さらにセル(0,0)にも同様の文字列を挿入します。
具体的なR,G,B各値の切り出しは、Function GetRGBsepalatelyの中で行っています。この関数では引数としてRGBを表すLong型整数と、R,G,Bのどの色成分を取り出すかを指定する整数(0,1,2のいずれか)を指定します。返す値は指定された色成分の強度(0から255)です。
もともとはExcelで特定のセルをクリックしたときにダイアログを出したいとき、セルの背景色によって特定のセルかどうかの判断をするというマクロを作ったことがあり、その移植を考えたときにセル背景の取得の確認のために作ったものです。例えば、黄色の背景色のセルをクリックしたら、入力用ダイアログを出すようにするためには、シート全体のセルのクリックに対するイベントハンドラを設定し、その中で背景色をチェックして黄色なら入力用ダイアログを表示し、黄色でなければ何もしない、という形になります。
お遊びプログラムでは、シート全体の背景色を青にしたセルにランダムにペアとなる言葉を同じく青色の文字色で配置し(たとえば百人一首の上の句と下の句)、クリックしたら背景色を白にして見えるようにし、神経衰弱ゲームを作るといったことができますね。
一度めくったセルは背景色が白かどうかで判別すればいいわけです。

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

Sub BackColorTest
    Dim oSheet as Object 
    Dim oCell As Object
    Dim oSel as Object
    Dim sRGB as String

    On Error Goto ErrorHandler
    oSheet = ThisComponent.CurrentController.ActiveSheet
    oSel = ThisComponent.CurrentController.getSelection() 
    'oSel =ThisComponent.CurrentSelection '上の書式でもどちらでも。
    
    if  not (oSel.ImplementationName = "ScCellObj") then
         oCell = oSheet.getCellByPosition(0, 0 ) 
        oCell.String="NoSingleSelection"
         Exit Sub
    End If
    
    sRGB = CStr(GetRGBsepalately(oSel.CellBackColor, 0))+ "-" + _
        CStr(GetRGBsepalately(oSel.CellBackColor, 1))+ "-" +_
        CStr(GetRGBsepalately(oSel.CellBackColor, 2))     
    
    MsgBox( sRGB )
    
    oCell = oSheet.getCellByPosition(0, 0 ) '書き込みセル指定
    oCell.String ="RGB=("+sRGB +")"
    Exit Sub
ErrorHandler:
    MsgBox "Error: " & Error
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

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

Lenovo ノートPC ThinkPad

iLEDについて

Javaサンプル

Netbeans

Libre Office Basicマクロ

その他

選択されているセルの背景色の取得