2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

全てのExcelファイルの全てのシートをA1セルに

Posted at

どうやって?

VBScriptとbatを組み合わせて頑張ります。

ソース

元のソースはここにあります。

VBScript

以下がメインの処理です。

excel_format.vbs
Call Main

'----------------------------------------------------
'
'   【Excelフォーマット】
'   本ファイルがあるディレクトリと同じディレクトリにある
'   すべてのExcel(*.xlsx, *.xlsm, *.xls)に対して、
'       ・A1をセルを選択
'       ・拡大率を100%
'   を全シートに行います。
'
'----------------------------------------------------
Sub Main()
    WScript.Echo "Excelフォーマット処理開始"
    'Excelインスタンス生成
    Dim objXlsx : Set objXlsx = CreateObject("Excel.Application")
    If IsNull(objXlsx) Then 
        Exit Sub
    End If

    'Excel非表示
    objXlsx.Visible = False
    
    '上書き保存のアラート非表示
    objXlsx.DisplayAlerts = False

    'FileSystemObjectインスタンス生成
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")

    'カレントディレクトリをセット
    Dim currentDirectory : Set currentDirectory = fso.GetFolder(".\")

    'カウント数 (カレントディレクトリにvbsとbatがある想定でマイナス2)
    Dim fileCount : fileCount = currentDirectory.Files.Count - 2
    Dim count : count = 1
    
    'ディレクトリ内を処理
    For Each file In currentDirectory.Files
        If IsExcel(fso.GetExtensionName(file)) Then
            Dim workbook : Set workbook = objXlsx.Workbooks.Open(file)
            SetAllA1(workbook)
            workbook.Saveas(file)
            workbook.Close
            Set workbook = Nothing
            WScript.Echo fileCount & "件中" & count & "件目処理終了"
            count = count + 1 
        End If
    Next
    objXlsx.Quit()
End Sub

'Excelかどうか判定
Function IsExcel (extention)
    IsExcel = False
    If extention = "xlsx" Or extention = "xls" Or extention = "xlsm" then
        IsExcel = True
    End If
End Function

'引数のブック内をすべてA1にセット
Sub SetAllA1 (workbook)
    Dim worksheet
    For Each worksheet In workbook.Worksheets
        workbook.Worksheets(worksheet.Name).Activate
        worksheet.Range("A1").Activate
        workbook.Windows(1).ScrollRow = 1
        workbook.Windows(1).ScrollColumn = 1
        workbook.Windows(1).Zoom = 100
    Next
    workbook.WorkSheets(1).Activate
End Sub

bat

以下はvbsファイルを呼び出す処理です。
vbs直で叩いてもOKですが、コンソール見えていると処理内容を追いやすいので一応用意しました。

excel_format.bat
cscript .\excel_format.vbs
pause

ソース解説

ざっくりほんのり解説しときます。

IsExcel

処理対象のファイルがExcelの場合にTrue, その他の場合にFalseを返します。

'Excelかどうか判定
Function IsExcel (extention)
    IsExcel = False
    If extention = "xlsx" Or extention = "xls" Or extention = "xlsm" then
        IsExcel = True
    End If
End Function

SetAllA1

ブック内のすべてのシートに対して処理を行います。

  • A1セルを選択
  • 画面左上に移動
  • 拡大率を100%

などをやっています。
他にもやりたいことがあればここに追記すればOK。

'引数のブック内をすべてA1にセット
Sub SetAllA1 (workbook)
    Dim worksheet
    For Each worksheet In workbook.Worksheets
        workbook.Worksheets(worksheet.Name).Activate
        worksheet.Range("A1").Activate
        workbook.Windows(1).ScrollRow = 1
        workbook.Windows(1).ScrollColumn = 1
        workbook.Windows(1).Zoom = 100
    Next
    workbook.WorkSheets(1).Activate
End Sub

Main

vbsファイルがあるディレクトリにある全てのファイルを取得してぐるぐる回して処理をしています。
書き方がイケてないとかは大目に見てもらえると嬉しいです。

Sub Main()
    WScript.Echo "Excelフォーマット処理開始"
    'Excelインスタンス生成
    Dim objXlsx : Set objXlsx = CreateObject("Excel.Application")
    If IsNull(objXlsx) Then 
        Exit Sub
    End If

    'Excel非表示
    objXlsx.Visible = False
    
    '上書き保存のアラート非表示
    objXlsx.DisplayAlerts = False

    'FileSystemObjectインスタンス生成
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")

    'カレントディレクトリをセット
    Dim currentDirectory : Set currentDirectory = fso.GetFolder(".\")

    'カウント数 (カレントディレクトリにvbsとbatがある想定でマイナス2)
    Dim fileCount : fileCount = currentDirectory.Files.Count - 2
    Dim count : count = 1
    
    'ディレクトリ内を処理
    For Each file In currentDirectory.Files
        If IsExcel(fso.GetExtensionName(file)) Then
            Dim workbook : Set workbook = objXlsx.Workbooks.Open(file)
            SetAllA1(workbook)
            workbook.Saveas(file)
            workbook.Close
            Set workbook = Nothing
            WScript.Echo fileCount & "件中" & count & "件目処理終了"
            count = count + 1 
        End If
    Next
    objXlsx.Quit()
End Sub

使い方

  1. 処理したい対象のExcelたちがあるディレクトリと同じところにvbsファイルとbatファイルを置く
  2. batファイルを叩くといい感じに処理してくれる

※vbsから出力するコメントはbatを叩く前提で入れてあります

まとめ

ExcelファイルのカーソルをA1セルに揃えておくのが良いかどうかという議論もありますが、
一旦そんな話は脇において、「全てのExcelファイルの全てのシートをA1セルに」したい人のためにスクリプト組んでおきました。
そのまま使うなり、カスマタイズして使うなり、ご自由にどうぞ!
動作確認はしていますが、使用は自己責任でお願いいたします。

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?