Excel マクロ(VBA) でシートを名前順でソートする
備忘録としてVBAマクロを掲載していくシリーズ。
シートをシート名昇順にソートするマクロ。
Excel マクロ(VBA) でシート一覧を作成の応用。
Sub シートをソート()
' 画面更新を一時的に無効化する。
Application.ScreenUpdating = False
Dim cnt As Long
cnt = Sheets.count
' 作業用シートをブック先頭に作成
Dim work As Worksheet
Set work = Worksheets.Add(Sheets(1))
' シート名一覧を作成する処理
Dim i As Long
For i = 1 To cnt
work.Cells(i, 1) = Sheets(i).Name
Next i
' 一覧をExcel標準機能でソート
work.Range("A1:A" & i).Sort Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess
' 一覧の順番通りにシートを並べ替える
For i = 1 To cnt
Sheets(work.Cells(i, 1).Value).Move before:=work
Next i
' シート削除時の警告表示を停止
Application.DisplayAlerts = False
' 作業用シートを削除
work.Delete
' 警告表示を再開する
Application.DisplayAlerts = False
' 画面更新を再開する
Application.ScreenUpdating = True
End Sub
Excel マクロ(VBA) でブック内の画像をすべて取り除く
備忘録としてVBAマクロを掲載していくシリーズ。
ブック内に大量に画像が張り付けてあって、それをすべて消す作業が発生したので、めんどくさくなったので下記のマクロにて処理。
まず、アクティブなシート内の画像を全て消す処理は、下記。
ActiveWorksheet.Pictures.Delete
これをForループで全シートに対して順次行ってあげるだけ。
Sub 画像をすべて取り除く()
Dim sht As Variant
For Each sht In Sheets
sht.Pictures.Delete
Next sht
End Sub
Excel マクロ(VBA) で対象セルに画像を張り付ける
備忘録としてVBAマクロを掲載していくシリーズ。
指定したセル上に、セルに寸法を合わせた画像を貼り付ける処理。
指定したセルが結合されたセルの場合、結合したセル全体のサイズに合わせる。
まずコア部分。
引数は下記の通り。
tgtRange : 貼り付ける先のセル（結合セルの場合は左上のセルを指定。)
fname : 貼り付ける画像のパス(省略した場合は、対象のセルに記入されたパスを参照する)
Function 対象セルに画像を張り付ける(ByRef tgtRange, Optional fname As String)
If fname = "" Then
If tgtRange.Text = "" Then Exit Function
fname = Replace(ActiveWorkbook.FullName, _
ActiveWorkbook.Name, "") & tgtRange.Text
End If
' 貼り付け位置・サイズの調整
' ( Width, Heightの指定が必須のため、仮の値を設定 )
Dim objShape
Set objShape = tgtRange.Parent.Shapes.AddPicture( _
Filename:=fname, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=tgtRange.Left + 1, _
Top:=tgtRange.Top + 1, _
Width:=tgtRange.MergeArea.Width, _
Height:=tgtRange.MergeArea.Height)
With objShape
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
'.LockAspectRatio = msoTrue '縦横費を固定。
.Width = tgtRange.MergeArea.Width
.Height = tgtRange.MergeArea.Height
End With
End Function
現在アクティブなセルに対して、画像選択ダイアログを開いて貼り付けるには、下記の関数を追加する。「Ctrl+Shift+V」とかショートカットを設定しておくと一発起動できて便利。
Sub 写真貼り付け()
'
' 写真貼り付け Macro
'
' Keyboard Shortcut: Ctrl+Shift+V
Dim t As Range
Set t = ActiveCell
Dim fname As String
fname = Application.GetOpenFilename ' ファイル選択ダイアログを開く。
If fname = "False" Then fname = ""
' ※ GetOpenFilename は、ファイルが選択されなかった時には、
' 文字列"False"を返す。
Call 対象セルに画像を張り付ける(t, fname)
End Sub
Excel マクロ(VBA) でシート一覧を作成
備忘録としてVBAマクロを掲載していくシリーズ。
いまあるシート名一覧を出力する方法。
ブックの末尾に新たにシートを追加して、そこに現在あるシート名一覧を出力する。
Sub シート一覧を作成()
Dim cnt as Long
cnt = Sheets.Count
Dim work As Worksheet
Set work = Worksheets.Add(, Sheets(cnt))
Dim i As Long
For i = 1 To cnt
work.Cells(i, 1) = Sheets(i).Name
Next i
End Sub
PT3導入したので、EpgTimerで録画したファイル名を書き換えるバッチ＋perlスクリプトを書いた
発売日に買ったのにずっと放置してたPT3をようやくPCに導入した。
で、EpgTimerで録画したTSファイルの録画情報ファイル(.ts.program.txt)からサブタイトルを抽出してTSファイルのファイル名に追記したいと思ったので、PerlとBATで何とかしてみた。
で、今回作ったプログラムの動作は、録画情報ファイルをrename.batにドラッグアンドドロップすることで動作するようにした。
Perlを選んだ理由は「何となく」。
最近使ってないのでちょっと使ってみたくなったので使っただけなので、特に意味は無い。
フォルダ構成
EpgTimer側で動画保存先を「D:\TV_RECORDING」としておく。
動画保存先フォルダに下記のような構成でファイルを作成する。
動画保存先(D:\TV_RECORDING\) └ rename\ ├ rename.bat └ rename.pl
このうちrename.batに録画情報ファイル(.ts.program.txt)をドラッグ&ドロップすると、rename.plを呼び出し、ファイル名書き換え処理を行う流れ。
EpgTimerの設定
「設定」→「動作設定」→「予約情報管理」から、「録画時のファイル名にPlugInを使用する」にチェックを入れ、下記の通り「設定」する。
$Title2$($SDYYYY$-$SDMM$-$SDDD$-$STHH$-$STMM$).ts （番組名(放送日時ハイフン区切り).ts）
構文がよくわからない。どこかにまとまってないかな。
なお今回は番組名と放送日時の間にサブタイトルを挿入するスクリプトをつくる。
ソース
rename.bat
@echo off setlocal ENABLEDELAYEDEXPANSION for %%i in (%*) do ( perl %~dp0rename.pl %%i )
「%*」は与えられた引数をすべて返すもの。EpgTimerの吐くファイル名は、モノによっては全角・半角スペースを含むモノが有り、%1だと通らないことがあるので注意。
[2014/04/05 加筆]複数のパスが渡されたときにパス毎にrename.plを呼び出すように改良。
次にrename.pl
use Config::Tiny; # SETTINGS ############################################################## # ファイルの拡張子 my %exp = ( "ts" => ".ts", "program" => ".ts.program.txt", "err" => ".ts.err" ); # 設定ファイルのパス my $ini = Config::Tiny->read('D:\TV_RECORDING\rename\settings.ini'); # ConvertText.txt ファイルのパス my $convfile = "C:\\Users\\Tatsuya\\app\\EpgDataCap_Bon\\x64\\ConvertText.txt"; # 使用禁止文字 my %replacechars = ( ':' => '：', ';' => '；', '/' => '／', '\\' => '￥', '|' => '｜', ',' => '，', '*' => '＊', '?' => '？', '"' => '”', '<' => '＜', '>' => '＞' ); ######################################################################### my $routine = ""; print "-------------------------------------------------\n"; # バッチからファイルパスを受け取る。 my $arg = shift; &message("arg : $arg\n"); my %fpath = ("ts"=>"", "err" => "", "program"=>""); if(!$arg) { &error("ファイルが指定されていません"); } $arg =~ s/\.ts\.err$//; $fpath{ts} = $arg.$exp{ts}; &message("[動画ファイルパス]\n$fpath{ts} ..."); -f $fpath{ts} ? &message("OK\n") : &error("ファイルがありません"); $fpath{err} = $arg.$exp{err}; &message("[エラーログファイルパス]\n$fpath{err} ..."); -f $fpath{err} ? &message("OK\n") : &error("ファイルがありません"); $fpath{program} = $arg.$exp{program}; &message("[動画情報ファイル]\n$fpath{program} ..."); -f $fpath{program} ? &message("OK\n") : &error("ファイルがありません"); &message("\n"); my @fpath = split(/\\/, $arg); # ファイル名を取得。 $fname = @fpath[$#fpath]; &message("ファイル名 : $fname($exp{ts}|$exp{program}|$exp{err})\n"); # ファイルのあるディレクトリのパスを取得。 @fdir = @fpath; pop @fdir; $fdir = join("\\", @fdir) . "\\"; &message("ファイル保存場所: $fdir\n"); $fname =~ /^(.*)(\(\d{4}-\d{2}-\d{2}-\d{2}-\d{2}\))$/; $before = $fname; my ($title, $time) = ($1, $2); &message("録画開始時刻 : $time\n"); &message("番組名 : $title\n"); &message("-------------------------------------------------\n"); &rename(%fpath); RENAME_END:; _END:; sub rename { my %fpath = @_; &message("# リネーム処理開始...\n"); $routine = "RENAME"; # 動画情報ファイルを開く。 open(FH, "< " . $fpath{program}) or &error( "動画情報ファイルの展開に失敗しました。\n" . "(指定されたパス: $fpath{base})"); # サブタイトルの抽出。 my $subtitle; while(my $line = <FH>) { print "[line]$line\n"; chomp($line); if($title eq "Ｚ／Ｘ ＩＧＮＩＴＩＯＮ" && $line =~ /ＰＨＡＳＥ([0-9０-９]+)/i) { $subtitle = "＃$1"; $subtitle =~ s/^(.*)』$/$1/; # なぜかカッコがついてきてしまうので削除。 last; } elsif($line =~ /^(#|＃|第)[0-9０-９]+/i) { $subtitle = $line; last; } } # 使用禁止文字の置換 while(my ($b, $a) = each(%replacechars)) { $subtitle =~ s/\Q$b\E/$a/g; } print "[subtitle]$subtitle\n"; $subtitle ? &message("サブタイトル : $subtitle\n") : &error("サブタイトルらしき文字列は見当たりませんでした。"); close(FH); if( $ini->{'command'}->{'rename_enable_yes'} ? 1 : &command("上記の内容でリネームしますか？" )) { &message("リネームします。\n"); # リネーム実行 my $rename = "$title$subtitle$time"; while( ($step, $e) = each(%exp) ) { my $before = "$fdir$before$e"; my $after = "$fdir$rename$e"; &message("[$step] $before ...\n... $after\n"); rename($before, $after) or &error("リネームエラー($e :$!)"); } $before = $rename; } else { &message("リネームをキャンセルしました。\n"); } &message("# リネーム処理終了...\n"); &message("-------------------------------------------------\n"); } sub command { &message(shift."(Y/N) "); my $in = <STDIN>; chomp $in; return ($in eq "y" || $in eq "Y" || $in eq "") ? 1 : 0; } sub message { # print encode("cp932", shift); print shift; } sub error { my $msg = shift; &message("[!]$msg\n"); my $in = <STDIN>; goto $routine."_END"; }
[2014/04/05 追記]ソースを一新した。とりあえず動いてるけど文字コードの関係でたまに文字化けするので改良予定。
以上。
