Moonmile Solutions Blog

ちっとばかり頭の体操の意味も込めて、Excel VBA を jQuery 風に弄れるかどうかのテストを。結論から言えば、結構いけます。行けるんじゃないだろうか？の段階まではできました。

Option Explicit

' 宣言
Private XL As New XLQuery

Sub test001()
    XL.Cell("A1").Text = "masuda"
    XL.Cell("A1:A10").Text = "masuda"
    ' 行列指定
    XL.Cell(1, 2).Text = "masuda"
    ' 範囲指定
    XL.Cell(1, 2, 10, 2).Text = "masuda"
    ' 名前定義
    XL.Cell("#name").Text = "masuda"
    ' クラス定義（実は名前）
    XL.Cell(".name2").Text = "masuda"
End Sub

Sub test002()
    ' 背景色を設定
    XL.Cell(1, 1).css("background-color") = "#FF0000"
    ' 文字色を設定
    XL.Cell("A2").css("color") = "blue"
End Sub

な風なコードを書くと、

な位まではできることが確認できました。

練習コードも含めてあるので、無駄が多いですが、ちょっと全コードを晒しておきますｗ 二つのクラス（XLQuery, XLRange）を作ってください。

XLQuery クラス

Option Explicit
''' excel vba query

Private EmptyBook_ As Workbook
Private EmptySheet_ As Worksheet
Private Current_ As Worksheet
Private Selection_ As Range

''' 簡易プロパティ
Public Property Get Application() As Excel.Application
    Applicaiton = Excel.Application
End Property
Public Property Get Book() As Workbook
    Set Book = Excel.ActiveWorkbook
End Property
Public Property Get Sheet() As Worksheet
    Set Sheet = Excel.ActiveSheet
End Property

''' コンストラクタ
Public Sub Class_Initialize()
    Set Current_ = Excel.ActiveSheet
    Set Selection_ = Excel.ActiveSheet.Cells(1, 1)
End Sub

''' Empty チェック
Public Property Get EmptySheet() As Worksheet
    Set EmptySheet = EmptySheet_
End Property
Public Function IsEmptySheet(sh As Worksheet) As Boolean
   Set IsEmptySheet = IIf(sh = EmptySheet_, True, False)
End Function

''' Worksheet を取得
Public Function GetSheet(name As String) As Worksheet
    Set GetSheet = EmptySheet_
    Dim sh As Worksheet
    For Each sh In Me.Book.Sheets
        If sh.name = name Then
            Set GetSheet = sh
            Exit For
        End If
    Next
End Function

''' カレントシートの設定/取得
Public Property Get Current() As Worksheet
    If Current_ Is Nothing Then
        Set Current = EmptySheet_
    Else
        Set Current = Current_
    End If
End Property
Public Property Let Current(v As Worksheet)
    If v Is EmptySheet Then v = Nothing
    Set Current_ = v
End Property

''' テキストを取得/設定
Public Property Get Text() As String
    If Selection_ Is Nothing Then
        Text = ""
    ElseIf Selection_ Is Range Then
        Dim rg As Range
        Set rg = Selection_
        Text = rg.Text

    Else
        Text = ""
    End If
End Property
Public Property Let Text(Value As String)
    If Not Selection_ Is Nothing Then
        If TypeOf Selection_ Is Range Then
            Selection_.Value = Value
        End If
    End If
End Property

''' セルにアクセス
Public Function Cell(r1 As String, Optional c1 As String = "", Optional r2 As String = "", Optional c2 As String = "") As XLRange
    Dim rg As New XLRange
    ' Cell("A1")呼出
    ' Cell("A1:B10")呼出
    ' Cell("#id")呼出
    ' Cell(".class")呼出
    If c1 = "" Then
        If Left(r1, 1) = "#" Then
            rg.self = Me.Sheet.Range(Mid(r1, 2))
        ElseIf Left(r1, 1) = "." Then
            rg.self = Me.Sheet.Range(Mid(r1, 2))
        Else
             rg.self = Me.Sheet.Range(r1)
        End If
    ' Cell(1,1)呼出
    ElseIf r2 = "" Then
        rg.self = Me.Sheet.Cells(CInt(r1), CInt(c1))
    ' Cell(1,1,2,10)呼出
    Else
        rg.self = Me.Sheet.Range(Me.Sheet.Cells(CInt(r1), CInt(c1)), Me.Sheet.Cells(CInt(r2), CInt(c2)))
    End If
    Set Cell = rg
End Function

XLRange クラス

Option Explicit
Private text_ As String
Private range_ As Range

Public Property Get Text() As String
    Text = text_
End Property
Public Property Let Text(v As String)
    text_ = v
    If Me.self Is Nothing Then Exit Property
    Me.self.Value = v
End Property

Public Property Get self() As Range
    Set self = range_
End Property
Public Property Let self(v As Range)
    Set range_ = v
End Property

Public Property Let css(prop As String, v As String)
    If Me.self Is Nothing Then Exit Property
    Select Case StrConv(prop, vbLowerCase)
    Case "background-color": self.Interior.Color = toRGB(v)
    Case "color": self.Font.Color = toRGB(v)
    End Select
End Property

Private Function toRGB(v As String)
    If Left(v, 1) = "#" Then
        Dim r, g, b
        r = CInt("&H" + Mid(v, 2, 2))
        g = CInt("&H" + Mid(v, 4, 2))
        b = CInt("&H" + Mid(v, 6, 2))
        toRGB = RGB(r, g, b)
    Else
        Select Case v
        Case "red": toRGB = RGB(255, 0, 0)
        Case "blue": toRGB = RGB(0, 0, 255)
        Case "green": toRGB = RGB(0, 255, 0)
		' このあたりは後で
        End Select
    End If
End Function

プロパティとパラメータの省略（option）を駆使して、それ風に動くようにします。VBA の制限としてクラスをひとつのファイルに複数のクラスを置けないので、利用する側を考慮してクラスは多くない様にします。なので、継承など本来のオブジェクト指向は無視して（苦笑）、使いやすい形で「オブジェクト」の部分だけ残しておくということで。
XLRange クラスの css プロパティを使って、スタイルシート風に設定ができるようにすれば、Excel のオブジェクトを覚えなくて良いので、その点は楽かなと。