VBScript で Excel を操作する方法

0 件のコメント

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

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

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

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

' Mainサブルーチン
Sub Main ()
  ' Excelアプリケーションのインスタンス生成
  Dim objXls : Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub

  ' Excelの表示
  objXls.Visible = True
  objXls.ScreenUpdating = False

  '
  ' いろいろ処理する…
  '

  ' Excelの終了
  objXls.ScreenUpdating = True
  objXls.Quit

  ' インスタンスの破棄
  Set objXls = Nothing
End Sub

' Mainサブルーチンの実行
Main

参考

ブックの操作

新規ブック作成

Sub Main ()
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing 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 ファイルは絶対パスで指定してあげる。

Sub Main ()
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing 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

ブックを保存する

上書き保存

Sub Main ()
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing 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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

名前を付けて保存

Sub Main ()
  Dim objXls, objWorkbook
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing 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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

参考

シートの操作

シート名一覧の取得

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  objXls.Visible = False

  ' シート名一覧を取得する
  For i = 1 To objWorkbook.Sheets.Count
    Set objWorksheet = objWorkbook.Sheets(i)
    If objWorksheet.Visible Then
      wscript.echo objWorksheet.Name
    End If
  Next

  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

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

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  objXls.Visible = True

  ' シート名を名称で指定して取得。1から始まるインデックスで指定もできる。
  Set objWorksheet = objXls.Sheets("Sheet4")

  ' アクティブシートに設定
  objWorksheet.Activate

  ' …いろいろ処理する…

  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

シートを追加/削除

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet1, objWorksheet2
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  objXls.Visible = True
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")

  ' 先頭に新規シートを追加
  Set objWorksheet1 = objXls.Sheets.Add(objXls.Sheets(1)) 

  ' 末尾に新規シートを追加
  Set objWorksheet2 = 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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

シート名を変更

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet1, objWorksheet2
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing 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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

セルの操作

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

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

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet, objRange, intR, intC
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  objXls.Visible = False
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objWorksheet = objWorkbook.Sheets("Sheet1")

  ' データのある範囲を取得
  Set objRange = objWorksheet.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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

セルの値を取得

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

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet, objRange
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  objXls.Visible = False
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objWorksheet = objWorkbook.Sheets("Sheet1")

  ' データ取得範囲を指定
  Set objRange = objWorksheet.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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

セルに値を書き込む

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet, objRange
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  objXls.Visible = True
  objXls.ScreenUpdating = True
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objWorksheet = objWorkbook.Sheets("Sheet1")

  ' 標準
  objWorksheet.Cells(1,1).Value = "あ"
  objWorksheet.Cells(1,1).NumberFormatLocal = "G/標準"

  ' 文字列
  objWorksheet.Cells(1,2).Value = "い"
  objWorksheet.Cells(1,2).NumberFormatLocal = "@"

  ' 数値
  objWorksheet.Cells(1,3).Value = "100.123"
  objWorksheet.Cells(1,3).NumberFormatLocal = "0_);[赤](0)"

  ' 日付
  objWorksheet.Cells(1,4).Value = "2018/9/1"
  objWorksheet.Cells(1,4).NumberFormatLocal = "yyyy/mm/dd"

  ' 時刻
  objWorksheet.Cells(1,5).Value = "20:00"
  objWorksheet.Cells(1,5).NumberFormatLocal = "hh:mm"

  ' パーセンテージ
  objWorksheet.Cells(1,6).Value = "60%"
  objWorksheet.Cells(1,6).NumberFormatLocal = "0%"

  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

参考

セルの書式を設定

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

Sub Main ()
  Dim objXls, objWorkbook, objWorksheet, objCell
  Set objXls = CreateObject("Excel.Application")
  If objXls Is Nothing Then Exit Sub
  objXls.Visible = True
  objXls.ScreenUpdating = False
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  Set objWorksheet = objWorkbook.Sheets("Sheet1")
  Set objCell = objWorksheet.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()
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

Main

参考

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

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