エクセルVBAに詳しい方! マクロの解説お願いします!

Question

以下のマクロについて、どういう動作を行っているかわかるように
1行ずつコメントを打って頂けないでしょうか？

エクセルのファイルを開き、
そのファイルに貼り付けてある図をすべてjpgに変換するマクロです。
(ネットで公開されていたのですが、どういう動作をしているか分かりませんでした)

特に[] は検索しても意味が分かりませんでした。
一体、どういう意味なんでしょうか？

Sub test()
    On Error GoTo e1
    'ダイアログを出してファイルを開く
    fn = Application.GetOpenFilename("Microsoft Excelブック (*.xls),*.xls", , "対象のファイルを開いてください")
    
    '画面の描画をOFFに
    Application.ScreenUpdating = False
    
    If fn <> False Then
        p = [B3]
        o = [B2]
        Select Case [C2]
            Case 1: pic = "図 (JPEG)"
            Case 2: pic = "図 (GIF)"
            Case 3: pic = "図 (PNG)"
            Case 4: pic = "図 (拡張メタファイル)"
        End Select
        
        Workbooks.Open Filename:=fn
        For Each ws In ActiveWorkbook.Sheets
            Sheets(ws.Name).Select
            For Each ss In ActiveSheet.Shapes
                If (ss.Name Like "Picture*" And p = True) _
                  Or (ss.Name Like "Object*" And o = True) Then
                    ss.Select
                    x = Selection.ShapeRange.Left
                    y = Selection.ShapeRange.Top
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.Cut
                    ActiveSheet.PasteSpecial Format:=pic
                    Selection.ShapeRange.Left = x + 10
                    Selection.ShapeRange.Top = y + 10
                End If
            Next
        Next
        ff = Mid(fn, InStrRev(fn, "\") + 1)
        ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls"
        fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls"
        ActiveWorkbook.SaveAs Filename:=fnd
        Windows(ff).Close
        
        'メッセージBOXを出してどれだけファイルサイズが小さくなったか比較
        MsgBox "前" & Format(FileLen(fn), "#,###バイト") & Chr(13) _
             & "後" & Format(FileLen(fnd), "#,###バイト") & Chr(13) _
             & "圧縮率" & Format(FileLen(fnd) / FileLen(fn), "0.0%"), , "終了"
    End If
    Application.ScreenUpdating = True
e1:
    MsgBox "エラーが発生しました"
End Sub

Wendy02 · Accepted Answer

ご質問のようなコードは、私にはさっぱりわかりませんね。だいたい、そのコードは思ったように動くのでしょうか？データ型の宣言もないし、Shapeを.Nameで、取るなんて、ある程度の経験者なら、そのようなことはしません。

そもそも、
>そのファイルに貼り付けてある図をすべてjpgに変換するマクロです。

何かの間違いではありませんか？単に、貼り付けた画像を、xlsファイルに分配するだけだと思います。

基本的には、Chartオブジェクトか、HTMLに保存して、そこから取り出すという方法だけだったと思います。不勉強のため、他にあるのかは知りません。

>　If (ss.Name Like "Picture*" And p = True) _
>　 Or (ss.Name Like "Object*" And o = True) Then

これってなんでしょうね。そもそも、p, o の条件もわかりません。
それに、名前で取るというのはかなりヘンです。

>ss.Select
>x = Selection.ShapeRange.Left
>y = Selection.ShapeRange.Top
そもそも、Select する必要もありませんね。

If ss.Type = msoPicture Then
　　 With ss
　　　 X = .Left
　　　 Y = .Top
　　 End With
　 End If

こうすれば良いです。

>On Error GoTo e1

>e1:

としたら、必ず、エラーが発生するというメッセージが出ます。el:の前に、Exit Sub が抜けています。

o = [B2]

>特に[] は検索しても意味が分かりませんでした。
そんな方法を覚えなくてもよいと思います。その中の引数は、ループカウンタを使えるわけではないし、通常使いません。

keithin · Answer

>ずらした位置に移動する意味はあるのでしょうか？

そのマクロを書いた人が，動かした方がいいと感じたのでそういうマクロにしたのでしょうね。
ホントの所何を考えてそうしたのかはマクロを書いた人に聞いてみるしかありませんが，あえて勝手に勝手に想像するなら，ぴくっとかずるっとか動くと，何か「した」のが判ってイイと思ったのかもしれませんね？？

動かしては困るのでしたら勿論そういう判断が大切ですから動かさないマクロにすればいいですし，逆にもっと「ここに動かしたい」のでしたら，そのようなマクロに直してご利用いただくと良いと思います。

keithin · Answer

ん？
一行一行の解説なんかホントは要らなくて，[]の説明だけ聞ければ満足だったのでしょうか？

一応コメントの中にも勿論説明は入れておきましたが，エクセルのヘルプでも見たいのでしたら（とりあえず2002以降の場合）
「ショートカットを使ってセルを参照する」
というトピックスに説明があります。見つけられなければ,「ショートカット」でヘルプの検索を使ってみると有ります。

まぁたまに質問相談掲示板の回答とかで使って回答されるのを見かける事もありますが，基本的にほとんどの人はそういうマクロは書かずに普通にrangeとかcellsを使います。よっぽど「タイピング数を減らすことに絶対的に命をかけてます」みたいな無意味なこだわりの人ぐらいじゃないでしょうか。
いや判って使う分には，例えばイミディエイトウィンドウでさくっと使ってみるなんかで若干便利な場合もありますけどね。

hallo-2007 · Answer

>特に[] は検索しても意味が分かりませんでした。
とは
p = [B3]
o = [B2]
Select Case [C2]
このことですよね。本当にこの様な記述の仕方は見慣れませんですね。調べてみても
http://officetanaka.net/excel/vba/speed/s10.htm
これぐらいしか見当たりませんでした。
[B3]　は　Rnage("B3") と置き換えておいて方が自分のためでもあり、今後他の人へ引継ぎとか考えると周りの人のためでもあると思います。
p oの変数の指定の部分が別のところにあると思い、あすが、表記のコードでは、変数の使用も1回しかありませんので
If (ss.Name Like "Picture*" And Rnage("B3") = True) Or (ss.Name Like "Object*" And Rnage("B2") = True) Then
でも作動しそうな気がします。
ss.Select
x = Selection.ShapeRange.Left
y = Selection.ShapeRange.Top
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Cut
ActiveSheet.PasteSpecial Format:=pic
Selection.ShapeRange.Left = x + 10
Selection.ShapeRange.Top = y + 10
も
ss.Select
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Cut
ActiveSheet.PasteSpecial Format:=pic
Selection.ShapeRange.Left = Selection.ShapeRange.Left
 + 10
Selection.ShapeRange.Top =  Selection.ShapeRange.Top+ 10
全体が見えているわけではないので、別名で保存するなどバックアップして、自分なりにわかりやすいコードに編集してみてください。
以下は、エラー処理についてのサイトです。
http://excelvba.pc-users.net/fol6/6_8.html
ff = Mid(fn, InStrRev(fn, "\") + 1)
ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls"
fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls"
も、もう少し整理できそうですが、InStrRev関数については
http://officetanaka.net/excel/vba/function/InStrRev.htm
などを参考にしてください。

keithin · Answer

>1行ずつコメントを打って頂けないでしょうか？
それは人にやって貰うんじゃなくマクロの判らない単語でF1キーを押し，ヘルプで各命令が実際どんな風に使われているか（間違っているか）調べるモノです。

Sub test()
'実行時トラップできるエラーが発生したらラベルe1に移動する
On Error GoTo e1
'開きたいファイル名をfnに格納する
fn = Application.GetOpenFilename("Microsoft Excelブック (*.xls),*.xls", , "対象のファイルを開いてください")

'画面更新を抑制する
Application.ScreenUpdating = False

'ファイルを開くダイアログでキャンセルを押しファイルを指定しなかったのではなかった場合（１）
If fn <> False Then
'ｐとｏにアクティブシートのb3とb2セルの値を格納
p = [B3]
o = [B2]

'c2セルの値に応じてc2が１２３４だったときはpictにあれこれを格納
Select Case [C2]
Case 1: pic = "図 (JPEG)"
Case 2: pic = "図 (GIF)"
Case 3: pic = "図 (PNG)"
Case 4: pic = "図 (拡張メタファイル)"
End Select

’fnのファイル名のファイルを開く
Workbooks.Open Filename:=fn

'アクティブブックのシートの全てについて巡回を開始する（２）
For Each ws In ActiveWorkbook.Sheets
’（２）をアクティブシートにする
Sheets(ws.Name).Select
’アクティブシート上の図形について巡回を開始する（３）
For Each ss In ActiveSheet.Shapes
’（３）の図形の名前がPicture何タラでかつpがTrueであるか，又は，図形名がObjectなんたらであってoがTrueであれば（４）
If (ss.Name Like "Picture*" And p = True) _
Or (ss.Name Like "Object*" And o = True) Then
’図形を選択し
ss.Select
’ｘとｙに選択図形のLeftとTopを格納し
x = Selection.ShapeRange.Left
y = Selection.ShapeRange.Top
’選択図形の外線を無しにして
Selection.ShapeRange.Line.Visible = msoFalse
’選択図形を切り取り
Selection.Cut
’切り取った図形をpictのフォーマットで貼り直す
ActiveSheet.PasteSpecial Format:=pic
’今選ばれてるもののを１０ずつずらした位置に移動する
Selection.ShapeRange.Left = x + 10
Selection.ShapeRange.Top = y + 10
’（４）の動作はここまで
End If
’（３）について繰り返す
Next
’（２）について繰り返す
Next
’fnからffとfndを加工する
ff = Mid(fn, InStrRev(fn, "\") + 1)
ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls"
fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls"
'アクティブブックをファイル名をfndで保存する
ActiveWorkbook.SaveAs Filename:=fnd
’ffを閉じる
Windows(ff).Close

'メッセージBOXを出して各ファイルの大きさと比率を計算して表示する
MsgBox "前" & Format(FileLen(fn), "#,###バイト") & Chr(13) _
& "後" & Format(FileLen(fnd), "#,###バイト") & Chr(13) _
& "圧縮率" & Format(FileLen(fnd) / FileLen(fn), "0.0%"), , "終了"
’（１）の終わり
End If
’画像の更新抑制を解除
Application.ScreenUpdating = True
’この部分でよくある間違いを犯している
’エラーセクションの開始
e1:
’メッセージボックスを表示する
MsgBox "エラーが発生しました"
End Sub

エクセルVBAに詳しい方! マクロの解説お願いします!

ご質問のようなコードは、私にはさっぱりわかりませんね。

この回答への補足

>ずらした位置に移動する意味はあるのでしょうか？

この回答への補足

ん？

この回答への補足

>特に[] は検索しても意味が分かりませんでした。

この回答への補足

>1行ずつコメントを打って頂けないでしょうか？

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング