いよいよ作っていきますよ
いろいろとくどくどと語ってまいりましたが、（その３）にしてやっと制作に入っていきます。
末尾にVBAのコードを載せておきますので、参照いただきながら解説していきます。
Excel VBAの知識がないと、この章を読むのはつまらないかもしれませんね。そんな方は下のファイルダウンロードだけゲットして、ここは読み飛ばしてもOKです。
Excel VBAの知識がないと、この章を読むのはつまらないかもしれませんね。そんな方は下のファイルダウンロードだけゲットして、ここは読み飛ばしてもOKです。
メイン
サンプルコード冒頭からご覧下さい。
タイトルコメントと、モジュール（≒グローバル）変数宣言のあと早速メインルーチンですが、めっちゃシンプルです。
タイトルコメントと、モジュール（≒グローバル）変数宣言のあと早速メインルーチンですが、めっちゃシンプルです。
数行の初期化処理の後、ループがひとつ。それだけ。
ループ内はコマンドを取り出して、Select Case文でそれぞれのコマンドごとに処理が書いてあります。ちょっと長くなるものはサブルーチンとして後ろの方に追い出してcallしています。
ここに新しくCase文と処理を書いていけば、お好きなコマンドを追加することができますよ。
ここに新しくCase文と処理を書いていけば、お好きなコマンドを追加することができますよ。
pick関数群
現在処理している行：指定した列のセルの値を返してくる関数群です。
まったく同じ処理が返値の型別に４種類用意してあります。
Excelのセル上にスクリプトを記述する仕組みなので、セルの列番号を指定するだけでコマンドや必要なパラメータを取得できます。普通だったら()やら""やら<>なんかで囲まれている文字がどうのこうのと真面目に構文解析するとかなり面倒ですが、このへん非常にらくちん処理になっております。
定数定義
メインの冒頭で呼ばれている定数初期化のサブルーチンです。
ここで、いわゆるxl定数を定義しています。
文字位置や線スタイルなどで指定できるのはこれらの値になります。
たったこれだけ
以下、メインから追い出されたコマンドのサブルーチン群があるだけで、VBAでのプログラミングはおしまいです。
あとは、これにかけるスクリプトをFileMakerで生成すればOKですね。次回はこれに挑戦します。
つづく。
・今回作成したサンプルファイル "ExcelMaker.xlsm"
あとは、これにかけるスクリプトをFileMakerで生成すればOKですね。次回はこれに挑戦します。
つづく。
サンプルダウンロード
・今回作成したサンプルファイル "ExcelMaker.xlsm"
サンプルコード（Excel VBA）
'ExcelMaker (example for the blog “BulldozeFileMaker”)
'By kamima 2017 email:kamima@mac.com
'力技FileMakerのための作例 2017.7
'ご自分のソリューションに自由にご利用ください
'書籍・ウェブ上の記事等への利用の場合はkamima@mac.comまでご一報いただけると励みになります
'Free to arrange/use for your solutions.
Dim makerBook As Workbook 'This WorkBook (contains this program)
Dim scriptSheet As Worksheet 'This WorkBook's sheet(1) "script"
Dim targetBook As Workbook
Dim targetSheet As Worksheet
Dim line As Long 'program counter
Dim constant As New Collection 'xl* constants (lineStyle etc.)
'//
'// main:
'//
Sub makeExcel()
Application.DisplayAlerts = False
line = 0
Set makerBook = ActiveWorkbook
Set scriptSheet = makerBook.Sheets(1)
Call init
Dim cmd As String
Do
line = line + 1
cmd = pickStr(1)
If cmd = "" Then cmd = "end"
Select Case cmd
Case "newBook"
Set targetBook = newBook(pickInt(2)) '(numOfSheets)
Set targetSheet = targetBook.Sheets(1)
Case "selectSheet"
Set targetSheet = targetBook.Sheets(pickInt(2)) '(sheetNum)
targetSheet.Select
Case "nameSheet"
targetSheet.Name = pickStr(2)
Case "width"
Call width
Case "height"
Call height
Case "widthRange"
targetSheet.Columns(pickInt(2) & ":" & pickInt(3)).columnWidth = pickInt(4)
Case "heightRange"
targetSheet.Rows(pickInt(2) & ":" & pickInt(3)).rowHeight = pickInt(4)
Case "write"
Call Write_
Case "merge"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).Merge
Case "fontSize"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).Font.Size = pickInt(6)
Case "hAlign"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).HorizontalAlignment = constant(pickStr(6))
Case "vAlign"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).VerticalAlignment = constant(pickStr(6))
Case "borders"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).borders.LineStyle = constant(pickStr(6))
Case "numberFormat"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).NumberFormatLocal = pickStr(6)
Case "shrinkToFit"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).ShrinkToFit = pickBool(6)
Case "wrapText"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).WrapText = pickBool(6)
Case "addIndent"
targetSheet.Range(Cells(pickInt(2), pickInt(3)), Cells(pickInt(4), pickInt(5))).AddIndent = pickBool(6)
End Select
Loop Until cmd = "end"
End
End Sub
'//
'// “pick” functions: fetch a command or a parameter
'//
Private Function pickStr(pos As Integer) As String
pickStr = scriptSheet.Cells(line, pos)
End Function
Private Function pickInt(pos As Integer) As Integer
pickInt = scriptSheet.Cells(line, pos)
End Function
Private Function pickSin(pos As Integer) As Single
pickSin = scriptSheet.Cells(line, pos)
End Function
Private Function pickBool(pos As Integer) As Boolean
pickBool = scriptSheet.Cells(line, pos)
End Function
'//
'// init: defines xl-constants
'//
Private Sub init()
constant.Add xlGeneral, "xlGeneral"
constant.Add xlLeft, "xlLeft"
constant.Add xlCenter, "xlCenter"
constant.Add xlRight, "xlRight"
constant.Add xlFill, "xlFill"
constant.Add xlJustify, "xlJustify"
constant.Add xlCenterAcrossSelection, "xlCenterAcrossSelection"
constant.Add xlDistributed, "xlDistributed"
constant.Add xlTop, "xlTop"
constant.Add xlContinuous, "xlContinuous"
constant.Add xlBottom, "xlBottom"
constant.Add xlDash, "xlDash"
constant.Add xlDashDotDot, "xlDashDotDot"
constant.Add xlDot, "xlDot"
constant.Add xlDouble, "xlDouble"
constant.Add xlSlantDashDot, "xlSlantDashDot"
constant.Add xlLineStyleNone, "xlLineStyleNone"
constant.Add xlHairline, "xlHairline"
constant.Add xlThin, "xlThin"
constant.Add xlMedium, "xlMedium"
constant.Add xlThick, "xlThick"
End Sub
'//
'// commands
'//
Private Function newBook(ByVal n As Long) As Workbook
Dim a As Long: a = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = n
Workbooks.Add
Application.SheetsInNewWorkbook = a
Set newBook = ActiveWorkbook
End Function
Private Sub width()
Dim i As Integer, target As Integer, columnWidth As Single
i = 0
target = pickInt(2)
Do
columnWidth = pickSin(3 + i)
If columnWidth = 0 Then Exit Do
targetSheet.Columns(target + i).columnWidth = columnWidth
i = i + 1
Loop
End Sub
Private Sub height()
Dim i As Integer, target As Integer, rowHeight As Single
i = 0
target = pickInt(2)
Do
rowHeight = pickSin(3 + i)
If rowHeight = 0 Then Exit Do
targetSheet.Rows(target + i).rowHeight = rowHeight
i = i + 1
Loop
End Sub
Private Sub Write_()
Dim x As Integer, y As Integer, i As Integer
i = 0
For y = pickInt(2) To pickInt(4)
For x = pickInt(3) To pickInt(5)
targetSheet.Cells(y, x) = scriptSheet.Cells(line, 6 + i)
i = i + 1
Next
Next
End Sub
0 件のコメント:
コメントを投稿