Notesってノーツと読むんだよ。

ExcelVBA起動

最終更新:

bottle

- view
メンバー限定 登録/ログイン

スクリプトからVBA for Excelを動かす

この手の質問がやはり多めなので、一応掲載。
やり方次第ですが、あるビューに表示されたDBの文書を
EXCELで書き出したりすることも可能です。

注意事項

VBA for Excelでの各メソッドで使用されるxl****のような定数は、
ノーツ・スクリプトにそのまま入力してもエラーするだけです。
かならず、以下のスクリプト例のようにConst宣言するか、
値のまま使用するかのどちらかで使用が可能になります。
定数の値のチェック方法は、VBA for Excelの定数の値を調べるを参照してください。

スクリプト例

以下のスクリプトは、あるCSVファイルをEXCELで整形及び集計させるための
ボタン・アクション用スクリプト。
#管理人の一言
前に懇談室でスクリプトからEXCELでソートができないというトピックありましたが、
それの回答になるかな?
(あの時はちとトラブってて回答できなかったの。。。)
あとは複雑な式言語(@関数)をどうやってスクリプトに組み込むか。の参照にもなると思います。
で、管理人はなぜExcel VBAを遅いフロントエンドで処理するかっていうと
動いてるのが実感できるように(PCがロックしてると思われるのがヤダ)してるだけ。

Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument

Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document

'Excelの定数は使えないので実際の値を定義します(定数名は同じにしてあります)
'Const xlPortrait = 1'縦

'入力チェック********************************************
flg = Messagebox ("集計表の作成を開始しますか?",33,"開始確認")
If flg = 2 Then
Messagebox"集計表の作成を中断します",64,"処理中断"
Exit Sub
End If

ERRMSG = "以下の項目が入力・選択されていません。"
motoERRMSG = ERRMSG

'入力チェック
If doc.Path(0) = "" Or doc.Path(0) = ".csv" Then
ERRMSG = ERRMSG + Chr(10) + "・パス取得"
End If

If ERRMSG <> motoERRMSG Then
Messagebox ERRMSG , MB_OK, "入力エラー"
Exit Sub
End If
'入力チェック終わり***********************************

Dim XObj As Variant 'Excel自体のオブジェクト
Dim Xwkbk As Variant 'ワークブック(1Excelファイル)
Dim XSheet1 As Variant 'シート
Dim XSheet2 As Variant 'シート
Dim i As Integer
Dim quotes As String
Dim strFormula1 As String, strFormula2 As String
quotes = Chr(34)

'エクセルのインスタンスを作成します
Set XObj = CreateObject("Excel.Application")
XObj.Visible = True
Set Xwkbk = XObj.workbooks
Xwkbk.Open(doc.Path(0)) '対象のファイルを開く
Set XSheet1 = XObj.Worksheets(1)'本体の表のシート

'★R6以降ではここから注意必要⇒参照
'=IF(OR(LEFT(RC[2],1)="P",LEFT(RC[2],1)="R",LEFT(RC[2],1)="Z")=TRUE,RIGHT(RC[2],1), _
'IF(LEFT(RC[2},1)="K",IF(MID(RC[2},2,1)="H","E",MID(RC[2},2,1)),IF(LEFT(RC[2},1)="H","E",LEFT(RC[2},1))))
'の式を変数に設定
strFormula1 = "=IF(OR(LEFT(RC[2],1)=" & quotes & "P" & quotes & ",LEFT(RC[2],1)=" _
& quotes & "R" & quotes & ",LEFT(RC[2],1)=" & quotes & "Z" & quotes & _
")=TRUE,RIGHT(RC[2],1)," & "IF(LEFT(RC[2],1)=" & quotes & "K" & quotes & _
",IF(MID(RC[2],2,1)=" & quotes & "H" & quotes & "," & quotes & "E" & quotes & _
",MID(RC[2],2,1)),IF(LEFT(RC[2],1)=" & quotes & "H" & quotes & "," & quotes & "E" & quotes & _
",LEFT(RC[2],1))))"

'=IF(LEFT(RC[1],1)="K","K"&MID(RC[1],3,5),MID(RC[1],2,5))の式を変数に設定
strFormula2 = "=IF(LEFT(RC[1],1)=" & quotes & "K" & quotes & "," & quotes & "K" & quotes & _
"&MID(RC[1],3,5),MID(RC[1],2,5))"

With XSheet1
.Name = "data"'シート名をdataに変更
.Activate'シートをアクティブに

'表の整形開始
.Columns.EntireColumn.AutoFit '列幅を自動で設定
.Columns("A:A").ColumnWidth = 10 'A列幅を10に
.Columns("C:C").ColumnWidth = 40 'C列幅を40に
.Columns("B:C").Insert'B~C列を挿入

'表題と式をB~C列に埋め込み
.Range("B1").FormulaR1C1 = "S/E/M"
.Range("C1").FormulaR1C1 = "共有No"
.Range("B2").FormulaR1C1 = strFormula1
.Range("C2").FormulaR1C1 = strFormula2
EndCellAdr = .Range("A1").End(-4121).Row'表の一番下のセルの行番号取得
.Range("B2:C2").Copy
.Range("B3:C"& EndCellAdr ).PasteSpecial'表の一番下までコピー内容を貼付

'小計行を削除する。
Set FCell = .Range("A1:A" & EndCellAdr).Find(":小計") '小計行を検索
Dim FCRow As Long
Do While Not FCell Is Nothing
FCRow = FCell.row
.Rows(FCRow).Delete'検索された小計行を削除
Set FCell = .Range("A1:A" & EndCellAdr).Find(":小計")
Loop

'今のシートをコピーして集計用シート作成
.Copy(XSheet1)
End With

Const xlSum = -4157
Dim aryCell(117) As Integer, cnt As Integer, m As Integer
cnt = 17 '初期化
For m = 0 To 117
aryCell(m) = cnt
cnt = cnt + 1
Next

Set XSheet2 = XObj.Worksheets("data (2)")'本体の表のシート
With XSheet2
'集計用シートの内容をソート
.Name = "集計1"'シート名を集計1に変更
.Activate
'表の一番下のセルの行番号取得
EndCellAdr = .Range("A2").End(-4121).Row
.Range("A2").Select
'ソート実行(第1ソート・キーはA2、第2ソート・キーはC2)
.Range("A2:ED" & EndCellAdr).Sort XSheet2.Range("A2"), 1, XSheet2.Range("C2")

'まず区分で集計
.Range("A1:ED" & EndCellAdr).Subtotal 1, xlSum, aryCell, False

'再度表の一番下のセルの行番号取得
EndCellAdr = .Range("A1").End(-4121).Row
.Range("A1:ED" & EndCellAdr).Subtotal 3, xlSum, aryCell, False '次に共有Noで集計
End With

End Sub

参照:Excelをバックエンドで処理させたい場合

以下の方法を使用することによりExcel出力が早くなります。
Re: FORMの内容をEXCELに出力して印刷したい。(by ドミノ懇談室(2006~))
#作成者
:かえる りわ (Riwa Kaeru) 2007/1/29 (Mon) 01:52 PM

Set excelApplication = CreateObject("Excel.Application")
Set excelWorkbook = excelApplication.Workbooks.open("ファイル名")
のように、ファイルをバックグラウンドで開き、
データの書き込みが全て終了した後に
excelApplication.Visible = True
で表示してあげれば表示更新の負荷を減らせるし、
データ書き込み中にユーザに触られる心配もありませんよ。

注意:R6以降のEvaluate関数の引数について

上に挙げた例で、R6以降にてEvaluate関数を使用するとエラーになるそうです。
R5では問題なく動きますけどね。。。
引数の式言語(@関数)にダブルクォーテーション等特殊文字を使用する場合の方法は以下を御参照ください。
Evaluate 関数が「Operation failed」エラーで終了する(by IBM公式)

ツッコミ・コメント

名前:
コメント:


目安箱バナー