Excel VBA で jQuery のようにアクセスできるライブラリを作れるか？

投稿日: 2012/02/28 作成者: masuda

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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 クラス

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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 クラス

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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 のオブジェクトを覚えなくて良いので、その点は楽かなと。

カテゴリー: 雑談, Excel VBA パーマリンク

Excel VBA で jQuery のようにアクセスできるライブラリを作れるか？ への1件のコメント

  1. masuda のコメント:
    2012/02/28 3:14 pm

    XLQuery だと接頭子が Excel 本家とバッティングするので、EvQuery あたりが良いですね。

コメントは停止中です。