NasupiiのPerl書抜帳

sheets_protectプログラムソースコード


Perl ソースコード

# sheets_protect.pl
# Copyright (C) 2013-2015 Nasupii         last update 2015/09/06
# Win32::OLEを使ってMS-Excel のワークシートにプロテクトを掛けるperlプログラム
# フォルダー内の全ファイルの全シートを対象にする。
# パスワードなしのプロテクトが掛かる。
# 使用確認環境
#   ActivePerl 5.16.3 と MS-Excel 2010 がインストールされた 
#     Windows Vistaにて動作確認しています。
#   ActivePerl 5.20.2 と MS-Excel 2010 がインストールされた 
#     Windows 7にても動作確認しています。
# 使い方
# 1.このプログラムをプロテクトを掛けたいExcelファイルが入ったフォルダー
#   にコピーする。
# 2.このプログラムをダブルクリックする。
# 3.コマンドプロンプトのウインドウが開き、ファイルを順番に処理していく。
# 4.「Enterを押すと終了します」が出たらエンターキーを押す。
# ================================================================================

# データファイルが入っているフォルダーを指定
# "." はプログラムを実行した同じフォルダーを表す。
# ここを変えると他のフォルダーのファイルを処理対象にすることが出来る
$PATH = "."; 

#モジュールのインポート
use Win32::OLE qw(in with);                  #OLEを使用する
use Win32::OLE::Const 'Microsoft Excel';     #エクセルのデータを扱う
use Cwd;

#アプリケーションオブジェクトの取得
$Excel = Win32::OLE->GetActiveObject('Excel.Application')
     || Win32::OLE->new('Excel.Application', 'Quit');

$Excel->{DisplayAlerts} = 'False';   #警告を表示しない

# ====== ファイル一覧の取得 ======
@files = ();  #配列の初期化
opendir(DIR, $PATH);   #ディレクトリを開く
while($file = readdir(DIR)) {
  print $file, " found\n";
  next unless(-f join("/", $PATH, $file)); #ファイル以外を除外
  next if($file !~ m/\.xls/);  # エクセルファイル以外を除外
  next if($file =~ m/^~\$/);  # ~$ エクセルが書き出すバックアップファイルを除外
  push(@files, "$file");
  print $file, " selected \n";
}

foreach $file (@files) {
  #ブックを開く
  $pathname = Cwd::abs_path(join("/",$PATH, $file));  #ファイルの絶対パスを求める
  $Book = $Excel->Workbooks->Open($pathname); 
  print "\nopen ",$pathname, "\n";

  #ワークシート数を取得
  $SheetCount = $Book->Worksheets->Count();
  print "sheetcount= $SheetCount\n";

  #ワークシート1から順番に処理していく
  for ($i = 1; $i <= $SheetCount; $i++ ) {
    $Sheet = $Book->Worksheets($i);
    $SheetName = $Sheet->Name; # 現在のシートの名前を取得
    # 処理を書く
    $Sheet->Protect;          #ワークシートをパスワードなしで保護する
    print "protect $i :", $SheetName, " \n"
  }
  $Book->Worksheets(1)->Select(); #ワークシート1を選択状態にする
  $Book->Save;                    #ワークシートを上書き保存する
  $Book->Close() ;                #ワークシートを閉じる
  print "close ", $pathname, "\n";
}
print "Enterを押すと終了します\n";
<STDIN>;
exit;