スクリプトからVBA for Excelを動かす
この手の質問がやはり多めなので、一応掲載。
やり方次第ですが、あるビューに表示されたDBの文書を
EXCELで書き出したりすることも可能です。
やり方次第ですが、あるビューに表示されたDBの文書を
EXCELで書き出したりすることも可能です。
注意事項
VBA for Excelでの各メソッドで使用されるxl****のような定数は、
ノーツ・スクリプトにそのまま入力してもエラーするだけです。
かならず、以下のスクリプト例のようにConst宣言するか、
値のまま使用するかのどちらかで使用が可能になります。
定数の値のチェック方法は、VBA for Excelの定数の値を調べるを参照してください。
ノーツ・スクリプトにそのまま入力してもエラーするだけです。
かならず、以下のスクリプト例のように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
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
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
'Excelの定数は使えないので実際の値を定義します(定数名は同じにしてあります)
'Const xlPortrait = 1'縦
'Const xlPortrait = 1'縦
'入力チェック********************************************
flg = Messagebox ("集計表の作成を開始しますか?",33,"開始確認")
If flg = 2 Then
Messagebox"集計表の作成を中断します",64,"処理中断"
Exit Sub
End If
flg = Messagebox ("集計表の作成を開始しますか?",33,"開始確認")
If flg = 2 Then
Messagebox"集計表の作成を中断します",64,"処理中断"
Exit Sub
End If
ERRMSG = "以下の項目が入力・選択されていません。"
motoERRMSG = ERRMSG
motoERRMSG = ERRMSG
'入力チェック
If doc.Path(0) = "" Or doc.Path(0) = ".csv" Then
ERRMSG = ERRMSG + Chr(10) + "・パス取得"
End If
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
'入力チェック終わり***********************************
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)
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)'本体の表のシート
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(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))"
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'シートをアクティブに
.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列を挿入
.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'表の一番下までコピー内容を貼付
.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
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
.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
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")
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
.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
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~))
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公式)
R5では問題なく動きますけどね。。。
引数の式言語(@関数)にダブルクォーテーション等特殊文字を使用する場合の方法は以下を御参照ください。
Evaluate 関数が「Operation failed」エラーで終了する(by IBM公式)