VBScript で Excel を操作する方法

2018年9月30日 0:21 2 件のコメント

今回は「VBScriptでExcelを操作する方法」についてまとめます。

Excel や Access でも スクリプト が書けますが、Officeアプリ上のVBは「VBA」と呼ぶようです。 今回のまとめは 「VBScript」 なので、アプリケーションの起動など出だし部分は「VBA」と若干異なる箇所があります。

目次

アプリケーションの起動/終了

CreateObject でインスタンス生成すればアプリケーションは起動する。 ただし Visible = True にしないと画面自体は表示されない。 たま、 ScreenUpdating をスクリプト処理中 OFF となるよう指定しておくと画面描画されなくなるのでスクリプト処理が高速化する。

?
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
' Mainサブルーチン
Sub Main ()
  On Error Resume Next
 
  ' Excelアプリケーションのインスタンス生成
  Dim objXls : Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
 
  ' Excelの表示
  objXls.Visible = True
  objXls.ScreenUpdating = False
 
  '
  ' いろいろ処理する…
  '
 
  ' Excelの終了
  objXls.ScreenUpdating = True
  objXls.Quit
 
  ' インスタンスの破棄
  Set objXls = Nothing
End Sub
 
' Mainサブルーチンの実行
Main

参考

ブックの操作

新規ブック作成

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
 
  ' Workbookを新規作成
  Set objWorkbook = objXls.Workbooks.Add()
 
  ' …いろいろ処理する…
 
  ' Workbookを閉じる
  objWorkbook.Close
 
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Main

ブックを開く/閉じる

開きたい Excel ファイルは絶対パスで指定してあげる。

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
 
  ' Workbookを開く
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
 
  ' …いろいろ処理する…
 
  ' Workbookを閉じる
  objWorkbook.Close
 
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

ブックを保存する

上書き保存

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
 
  ' Workbookを開く
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
 
  ' …いろいろ処理する…
 
  ' Workbookを保存
  objWorkbook.Save
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
 
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

名前を付けて保存

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
 
  ' Workbookを開く
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
 
  ' …いろいろ処理する…
 
  ' Workbookを保存
  objWorkbook.SaveAs(GetCurrentDirectory() & "\test2.xlsx")
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

参考

シートの操作

シート名一覧の取得

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  objXls.Visible = False
 
  ' シート名一覧を取得する
  For i = 1 To objWorkbook.Sheets.Count
    Set objSheet = objWorkbook.Sheets(i)
    If objSheet.Visible Then
      wscript.echo objSheet.Name
    End If
  Next
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

シート名を指定してアクティブにする

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  objXls.Visible = True
 
  ' シート名を名称で指定して取得。1から始まるインデックスで指定もできる。
  Set objSheet = objXls.Sheets("Sheet4")
 
  ' アクティブシートに設定
  objSheet.Activate
 
  ' …いろいろ処理する…
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

シートを追加/削除

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet1, objSheet2
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
 
  ' 先頭に新規シートを追加
  Set objSheet1 = objXls.Sheets.Add(objXls.Sheets(1))
 
  ' 末尾に新規シートを追加
  Set objSheet2 = objXls.Sheets.Add( ,objXls.Sheets(objXls.Sheets.Count))
 
  ' シート名を指定して削除。
  objXls.DisplayAlerts = False      ' データがあるとアラート表示されるので一時的に消す。
  objXls.Sheets("Sheet1").Delete
  objXls.DisplayAlerts = True
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

シート名を変更

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet1, objSheet2
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
 
  ' "Sheet1" を "シートx" に変更
  objWorkbook.Sheets("Sheet1").Name = "シートx"
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

セルの操作

データのあるセル範囲を取得

データのあるセルは Worksheet.UsedRange で取得きる。 取得された Range にオフセットがある場合、オフセットセル数は Range.Row および Range.Column がオフセットになる。

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet, objRange, intR, intC
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = False
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objSheet = objWorkbook.Sheets("Sheet1")
 
  ' データのある範囲を取得
  Set objRange = objSheet.UsedRange
 
  ' データ範囲を表示
  For intR = 1 To objRange.Rows.Count
    For intC = 1 To objRange.Columns.Count
      wscript.echo _
        "[" & objRange.Row + intR - 1 & ","  & objRange.Column + intC - 1 & "]" & _
        objRange(intR, intC).Text
    Next
  Next
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

セルの値を取得

Range.Value でも値は取れるがシリアル値になる。 日付やパーセンテージは表示されている値で取得したほうが良いので Range.Text で値を取得する。

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet, objRange
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = False
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objSheet = objWorkbook.Sheets("Sheet1")
 
  ' データ取得範囲を指定
  Set objRange = objSheet.Range("A1:E2")
 
  ' データを表示
  For intR = 1 To objRange.Rows.Count
    For intC = 1 To objRange.Columns.Count
      wscript.echo _
        "[" & objRange.Row + intR - 1 & ","  & objRange.Column + intC - 1 & "]" & _
        objRange(intR, intC).Text
    Next
  Next
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

セルに値を書き込む

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet, objRange
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
  objXls.ScreenUpdating = True
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objSheet = objWorkbook.Sheets("Sheet1")
 
  ' 標準
  objSheet.Cells(1,1).Value = "あ"
  objSheet.Cells(1,1).NumberFormatLocal = "G/標準"
 
  ' 文字列
  objSheet.Cells(1,2).Value = "い"
  objSheet.Cells(1,2).NumberFormatLocal = "@"
 
  ' 数値
  objSheet.Cells(1,3).Value = "100.123"
  objSheet.Cells(1,3).NumberFormatLocal = "0_);[赤](0)"
 
  ' 日付
  objSheet.Cells(1,4).Value = "2018/9/1"
  objSheet.Cells(1,4).NumberFormatLocal = "yyyy/mm/dd"
 
  ' 時刻
  objSheet.Cells(1,5).Value = "20:00"
  objSheet.Cells(1,5).NumberFormatLocal = "hh:mm"
 
  ' パーセンテージ
  objSheet.Cells(1,6).Value = "60%"
  objSheet.Cells(1,6).NumberFormatLocal = "0%"
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

参考

セルの書式を設定

罫線の線種や太さを示す定数が VBScript 上では使えないので直接値を指定する。 Excel VBA などでは定数が使えるので定数を使うと簡単。

?
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
Sub Main ()
  On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet, objCell
  Set objXls = CreateObject("Excel.Application")
  If Not objXls Then Exit Sub
  objXls.Visible = True
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objSheet = objWorkbook.Sheets("Sheet1")
  Set objCell = objSheet.Range("B3")
  objCell.Value = "ほげほげほげお"
 
  ' 文字
  objCell.Font.Name = "メイリオ"                      ' フォント
  objCell.Font.Color = RGB(256, 0, 0)     ' 文字色
  objCell.Font.Size = 12                  ' サイズ
  objCell.Font.Italic = True                            ' イタリック
  objCell.Font.Bold = True                                ' 太字
 
  ' 背景
  objCell.Interior.Color = RGB(192, 192, 192)
 
  ' 罫線
  objCell.Borders.LineStyle = 1           ' 線種
  objCell.Borders.Weight = 1              ' 太さ
  objCell.Borders.Color = RGB(0, 0, 128)  ' 色
 
  objWorkbook.Close
  objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
 
Main

参考

今回は「VBScript で Excel を操作する方法」についてまとめました。 参考になったでしょうか？ 本記事がお役に立っていると嬉しいです！！

最後に… このブログに興味を持っていただけた方は、 ぜひ 「Facebookページ に いいね！」または 「Twitter の フォロー」 お願いします！！

 

  1. nukie2019年7月16日 18:57

    初めまして、コメント失礼します。

    記事内のコードにいくつか気になる点があります。

    # アプリケーションの起動/終了

    `If objXls Is Nothing Then Exit Sub`のコードはExcelの起動に失敗した場合を想定していると思われますが、記事のコードでは以下の二つの要因で期待したとおりに動作しないはずです。

    一つ目の要因は`CreateObject`は失敗したときエラーを起こすことです。
    記事のコードには`On Error ~`などのエラー処理ステートメントが存在していないため、エラーが起きた時点で処理が停止し、If文まで到達しません。


    二つ目の要因は、VBScriptの変数の初期値は`Empty`であり、`Nothing`では無いことです。

    Variant型の変数の初期値である`Empty`は、数値として比較すると`0`、文字列として比較すると空文字列(`""`)として評価されますが`Nothing`としては評価されません。

    そのため、現状のコードでは`objXls`が`Nothing`になることはあり得ません。


    上記の点の対応としてエラー処理などをしても良いですが、個人亭には「Excelが起動出来ない」という時点で全ての前提が崩壊するため、何も対処しない、というのも手だとは思います。



    # シート名一覧の取得

    こちらに関しては参考程度の話ですが、For文の処理についてです。

    まず気になったのが、`objWorkbook.Sheets.Count`と、全ての種類のシートの枚数を元にループを行っているにも関わらず、
    `Set objWorksheet = objWorkbook.Sheets(i)`と、Worksheetしか想定していないような変数で受け取っている点です。

    Excelにはワークシート以外にもグラフシートなどが存在し、`Sheets`はそれら全ての集合を示します。
    ワークシートしか想定しないのであれば、`Worksheets`を使う方が適切です。

    そしてこちらは好みの話ですが、結局変数に入れるのであればFor文ではなく、For Each文を使った方が記述がすっきりして見やすくなると思われます。

    返信削除
    返信
    1. Akinari Tsugo2019年8月24日 11:54

      nukie さん

      ご指摘ありがとうございます。
      エラー処理はあまり気にしていなかったので助かります（さすがにExcelはあるだろう前提でした…）。
      記事のコードについて、以下を見直しました。

      ・エラー処理
      　- "On Error Resume Next" を追加
      　- objXls の比較は Nothing ではなく単純に Not で確認
      ・objWorkSheet の名称を objSheet に変更

      ループに関しては For Each が使える場合、そちらが良いと思います。
      この記事でシート番号を使ったループにしたのは「シート番号を指定してシートを取得するユースケース」があると思い、わざとそのような記述をしていました。
      なので、ここはもとのままの記述にしてあります。

      よろしくお願いいたします。

      削除