2020/04/14

回転させた画像をシートに貼り付ける

• １．背景
• ２．対応方針
• ３．画像の回転について
• ４．マクロの概要
• ５．プログラム
• 　５－１．フォームの作成
• 　　５－１－１．WebBrowserコントロールを使うための準備
• 　　５－１－２．WebBrowserコントロールの配置
• 　５－２．フォームのInitializeイベントプロシージャ
• 　５－３．フォームのイベントプロシージャ
• 　　５－３－１．エラー処理
• 　　５－３－２．画像の貼付け
• 　　５－３－３．画像サイズ変更
• 　　５－３－４．画像貼付け位置変更
• 　５－４．標準モジュール
• 　５－５．拡張子による仕訳け
• ６．Excelのアドインファイルにする
• ７．最後に

１．背景

以前「画像を直接シートに貼り付ける」で、画像をシートに貼り付ける方法について紹介しました。
しかし同時に問題点も明らかになりました。
　①画像であるＰＤＦは貼り付けられない。
　②動画も貼り付けられない。
　③回転させた画像は画像比が崩れる。また位置もズレる。
この内①②の対策については「あらゆるファイルをシートに貼り付ける」で紹介しましたので参照願います。
残る③の対策について、本項で紹介します。

２．対応方針

まず、「画像を直接シートに貼り付ける」で使用した「画像を貼り付ける部分のコード」を図２－１に再掲します。

1. '==========　⇩①　画像を貼り付けるコード　============
2. 　sh = ActiveSheet.Shapes.AddPicture _
3. 　　　　　FileName:=FilePath, _
4. 　　　　　LinkToFile:=False, SaveWithDocument:=True, _
5. 　　　　　Left:=Selection.Left, Top:=Selection.Top, _
6. 　　　　　Width:=Pict_W, Height:=Pict_H

図２－１

この「.Shapes.AddPicture」メソッドは、貼付け位置（LeftとTop）と貼付けサイズ（WidthとHeight）を必ず指定する必要があります。ですので事前にファイルを「LoadPicture」を使って調べ、画像サイズを取得し、この「貼付けコード」の時に「サイズも含めて一気に貼って」しまおう、というのが前回の意図でした。
ところが、画像が回転していると画像の縦横サイズが目で見える状態とは異なり、画像が変形してしまう　というのが今回の不具合です。また、貼り付ける位置も少しだけズレてしまう不具合も同時にありました。

しかし画像が回転しているか否かは、画像ファイルを「LoadPicture」を使って読み込んだ時点では取得することができません。
一方「.Shapes.AddPicture」で画像を貼り付けた後でなら取得できる事がわかりました。

だったら「最初に画像を貼り付けてしまい、あとで回転有無を確認しながらサイズを修正」するしかない、というのが今回の内容です。

なお、貼り付ける前に画像サイズを取得する場合は、PNGとTiff（Tif）はLoadPictureで画像取得できないために、バイト単位で画像サイズを探していました。しかし、この「まずは貼付け方式」ではPNGもTiff（Tif）も画像として貼れてしまいますので、難しいバイト単位での解析が不要になります。
つまり、画像は全て一種類のコードで対応できるのです。

３．画像の回転について

画像を回転させるには、図３－１左のようにエクスプローラ上で回転させたり、図３－１右のようにアプリ内で回転させたりします。また、最近のデジカメには縦に構えて撮影すれば写真も回転するものもあります。

図３－１

今回いろいろ試してみたのですが、回転情報が保存されるのはJPEGファイルだけのようです。（間違っていたらごめんなさい）
逆に「回転させた状態が正規の画像の形」として保存されれば、「画像を直接シートに貼り付ける」のプログラムで何ら問題ないのです。
しかし決して少なくない種類のJPEGに於いて回転情報が保存されるので、放っておくわけにも行きません。

回転情報は、貼り付けた画像（Shape）オブジェクトのRotationプロパティで得られます。その回転情報と画像状態との関係を調べてみたのが図３－２です。

図３－２

画像を時計方向に回していくと、９０度・１８０度・２７０度・０度と回転情報のRotation値が変わっていきます。
また、どう回転させても「元の画像状態での幅(Width)・高さ(Height)・画像位置の基準点は動かない」事が分かります。

ですので、例えば９０度回転させた画像では、見掛けの画像幅は.Heightで得られ、画像高さは.Width で得られます。
また、画像をある位置に合わせようとすると、元画像の左上角である図３－２の「」の位置を合わせてきます。
そのため、.Widthと.Heightの値を使って補正してあげる必要があります。

４．マクロの概要

以上を踏まえて作成したのが、図４－１になります。（見掛けは前回までと変わりません）

図４－１

このマクロの取扱説明書を書くとすると、以下のようになります。
＜操作方法＞
１）ダイアログを事前に起動しておく。
２）ワークシート上で「画像を貼り付ける位置とサイズ」を範囲選択する。
３）エクスプローラ等から画像ファイルをダイアログに「ドラッグ＆ドロップ」する。
４）選択セル範囲に画像が貼り付く。
５）回転させた画像も、見掛けの状態で貼り付く。

＜仕様＞
１）貼付け方法として「①セルにフィット」と「②元画像の縦横比を維持」が選べます。
　　①セルフィット：元画像の縦横比を崩してでも選択範囲の形にフィットさせます。
　　②元画像比維持：元画像の縦横比はそのままに、選択範囲内に収まるように貼り付けます。

＜対応している画像ファイル種類＞・・・添付ファイルのUserForm2の仕様
「JPG（JPEG）」「GIF」「BMP」「ICO」「RLE」「WMF」「EMF」「PNG」「TIFF（TIF）」
尚、マルチページTIFFは先頭頁が貼られます。またGIFは動く画像として貼られる訳ではありません。
（「RLE」については動作未確認です。）

５．プログラム

本マクロは、Excelにアドインすることを前提に作成しています。
また、ドロップのためのフォームコントロールには、ドロップファイルの情報を取得できる「ListViewコントロール」「WebBrowserコントロール」などがありますが、今回はどのExcelバージョンでも使用できる（はずの）WebBrowserコントロールを使用します。

ListViewコントロールは複数のファイル情報を受け取れるので利用価値が高いと思いますが、使えないExcelバージョンが有りそうなので今回は割愛します。ListViewに改造したい方は「画像を直接シートに貼り付ける」を参照下さい。

５－１．フォームの作成

５－１－１．WebBrowserコントロールを使うための準備

WebBrowserコントロールは、本来 IE や Edge のように「サイトをExcelフォーム上に表示させる」ものです。しかし、その機能の一つにドロップしてきたファイル名を取得できるものがありますので、今回はそれを活用します。
しかし、WebBrowserコントロールは標準では表示されていませんので、まず図５－１の方法でツールボックスに追加をします。

１）ツールボックス上でマウスを右クリックし、「その他のコントロール」を選択します。
２）リストの中から「Microsoft Web Browser」を選択（先頭にレ点を付ける）し、ＯＫボタンを押します。
３）ツールボックスにWebBrowserマーク「」が追加されます。


図５－１

５－１－２．WebBrowserコントロールの配置

ツールボックスにWebBrowserが追加できましたら、クリックしてフォーム内に図５－２の様にWebBrowserコントロールを配置します。


図５－２

「WebBrowser」コントロールには外枠線のプロパティが無く、ボケて見える気がします。
その対策として、先に「フレーム」を配置（Captionは空にする）し、その上から「WebBrowser」を重ねると、少し輪郭がはっきりします。
尚、WebBrowserの範囲は真っ黒となっていますが、実行時は白背景になります。

５－２．フォームのInitializeイベントプロシージャ

フォームを起動する時にフォームの初期化をするのが図５－３のInitializeイベントプロシージャです。
特に設定は必要無く、ここではタイトルを表示するくらいです。

1. '==========　⇩①　フォームの初期設定(WebBrowser用)　============
2. Private Sub UserForm_Initialize()
3. 　Me.Caption = "画像トンネル"　　　　　　 ’←フォームのタイトル表示
4. End Sub

図５－３

５－３．フォームのイベントプロシージャ

画像ファイルをドロップした時に発生するイベントは、WebBrowserでは「BeforeNavigate2」イベントになります。
その引数の内の「URL As Variant」で、ドロップしたファイルの「パス名＋ファイル名」が受け取れます。

5. '==========　⇩②　ファイルをドロップした時のイベントプロシージャ（WebBrowser）　===========
6. Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
7. 　Dim Sh As Shape　　　　　　　　　　 ’←貼り付けた画像のオブジェクト
8. 　Cancel = True
9. 　Application.ScreenUpdating = False
11. 　If Dir(URL ,3 ) = "" Then　　　　　　　 ’←ﾌｫﾙﾀﾞそのものだったら終了
12. 　　MsgBox "ファイルではありません"
13. 　　Exit Sub
14. 　End If
16. 　Set Sh = ActiveSheet.Shapes.AddPicture _
17. 　　　　　(Filename:=URL _
18. 　　　　　, linktofile:=False, savewithdocument:=True _
19. 　　　　　, Left:=0, Top:=0, Width:=-1, Height:=-1)　　 ’←元の画像サイズで貼り付ける
21. 　With Sh
22. 　　Select Case .Rotation　　　　　　　　　　　　 ’←画像の回転角を調べ、画像サイズを調整
23. 　　　Case 90, 270
24. 　　　　If Me.OptionButton1.Value = True Then
25. 　　　　　.LockAspectRatio = msoFalse　　　　　　 ’←画像比固定を無効にする
26. 　　　　　.Height = Selection.Width
27. 　　　　　.Width = Selection.Height
28. 　　　　Else
29. 　　　　　.LockAspectRatio = msoTrue　　　　　　　 ’←画像比固定を有効にする
30. 　　　　　If (Selection.Width / Selection.Height) / (.Height / .Width) >= 1 Then
31. 　　　　　　.Width = Selection.Height
32. 　　　　　Else
33. 　　　　　　.Height = Selection.Width
34. 　　　　　End If
35. 　　　　End If
36. 　　　Case Else
37. 　　　　If Me.OptionButton1.Value = True Then
38. 　　　　　.LockAspectRatio = msoFalse
39. 　　　　　.Width = Selection.Width
40. 　　　　　.Height = Selection.Height
41. 　　　　Else
42. 　　　　　.LockAspectRatio = msoTrue
43. 　　　　　If (Selection.Width / Selection.Height) / (.Width / .Height) >= 1 Then
44. 　　　　　　.Height = Selection.Height
45. 　　　　　Else
46. 　　　　　　.Width = Selection.Width
47. 　　　　　End If
48. 　　　　End If
49. 　　End Select
51. 　　Select Case .Rotation　　　　　　　　　　　 ’←画像の回転角を調べ、貼付け位置を調整
52. 　　　Case 90, 270
53. 　　　　.Left = Selection.Left - (.Width - .Height) / 2
54. 　　　　.Top = Selection.Top + (.Width - .Height) / 2
55. 　　　Case Else
56. 　　　　.Left = Selection.Left
57. 　　　　.Top = Selection.Top
58. 　　End Select
59. 　End With
60. 　Application.ScreenUpdating = True
61. End Sub

図５－４

このWebBrowserコントロールに「一度に複数ファイルをドロップ」することは可能ですが、６行目のWebBrowserイベントでは１つ目のファイル名しか受け取れません。しかも「ドロップしたファイルは何個あるのか」の情報も受け取る術がありませんので、エラーのコメントを出すことも出来ません。
ですので、ユーザには「１つずつドロップして」と、使い方を周知させる必要があります。

７行目の「Sh」変数には、貼り付けた画像を１６行目で代入し、その画像サイズ変更（２２～４９行目）と貼付け位置変更（５１～５８行目）する為に使用します。

８行目の「Cancel = True」は、「サイトの移動操作を取り消す」という意味です。WebBrowserはサイト等を表示するために存在しますので「ドロップしてきたファイル先に移動（＝表示）」しようとします。しかしコントロール内に表示されても困るので、表示をCancelしています。

９行目の「Application.ScreenUpdating = False」は６０行目で解除するまでの間、画面更新を停止させるものです。今回のマクロでは、一旦画像をシートに貼り付けた後でサイズと貼付け位置を変更していますので、どうしても画面がちらつきます。そのちらつき（≒処理速度低下）を抑えるものです。

５－３－１．エラー処理

１１～１４行目は、フォルダーそのものをドロップした時のエラー処理です。
実は「.Shapes.AddPicture」は、「何でも貼ろうとする」メソッドです。Excelファイル（.xlsx等）やPDFファイルもエラーを出さずに貼ろうとしますが、「画像にならないもの」は図５－５のように「エラー」として貼り付けられます。

図５－５

しかし、フォルダーだけは貼れずにエラーが発生します。「On Error Resume Next」などでエラーを回避しても図５－６のようなエラーダイアログが出てからExcelがダウンします。

図５－６

このエラーを回避するために、１１行目の「If Dir(URL ,3) = "" Then」を使って「フォルダーだったらコメントを出してマクロを終了」させています。

「Dir関数」は、第一引数（この場合はURL）に指定したファイルが存在したとき「そのファイル名を返す」関数で、「ファイルが見つからないときは長さ０の文字列」を返します。

また、存在を確かめる対象（ファイル属性）を図５－７から選び、値を足したものを第二引数に設定します。
１１行目では「３」になっていますので、標準ファイル＋読み取り専用ファイル＋隠しファイル　を対象にしている事を示します。

定数	値	説明
vbNormal	0	標準ファイル（既定値）
vbReadOnly	1	読み取り専用ファイル
vbHidden	2	隠しファイル
vbSystem	4	システム ファイル(Windowsのみ)
vbVolume	8	ボリューム ラベル(Windowsのみ)
vbDirectory	16	フォルダ
vbAlias	64	エイリアス ファイル(Macintoshのみ)

図５－７

「フォルダを対象にするんだから　If Dir(URL ,16) < > "" Then ではダメ？」と考える方もいるかもしれませんが、間違っています。
１６＝１６＋０なので「フォルダ＋標準ファイル」が対象になってしまい、読み取り専用と隠しファイルしか貼り付けられなくなってしまいます。
（しかし色々試してみると、Dir(URL ,2)でも読み取り専用ファイル名を取得してしまう（２＋０なので、標準ファイル＋読み取り専用ファイルだけが対象のはずだけど・・）ので、何かまだ間違っているのかもしれません。）

５－３－２．画像の貼付け

１６行目は、画像を実際に貼り付けています。そして「貼り付けた画像（Shape）をSh変数に代入」しています。

図５－８の通り引数としては７つあり、全て指定する必要があります。

引数	内容	今回の指定
FileName	貼り付けるﾌｧｲﾙ名	ﾄﾞﾛｯﾌﾟしたﾌｧｲﾙ名だから引数URL
LinkToFile	ﾌｧｲﾙとのﾘﾝｸを保つか	ﾃﾞｼﾞｶﾒ等とのﾘﾝｸ切れる可能性が有る為｢False｣
SaveWithDocument	図を一緒に保存するか	図を一緒に保存するため｢True｣
Left	図の左上隅の位置	どこでも良いが原点｢0｣とした
Top	図の左上隅の位置	どこでも良いが原点｢0｣とした
Width	貼り付ける図の幅	元の図の幅だから｢-1｣
Height	貼り付ける図の高さ	元の図の高さだから｢-1｣

図５－８

引数（図５－８）の中で「Left」「Top」は何でも良く、「とにかく一度貼り付けないと、回転しているか分からない」ので、とりあえず「0,0」（Excel の左上隅）にしています。
また「Width」「Height」は、値を指示してしまうと変形してしまいますので、「元画像のまま」という意味の「-1」を指定しています。

５－３－３．画像サイズ変更

画像が貼り付いたら、２２～４９行目で画像サイズを変更します。サイズを決めるには３つの条件が必要です。
　１）回転角度
　２）セルフィット or 画像比維持
　３）選択範囲と画像の縦横比の比較

この３条件で、どのようにサイズを設定すれば良いかを、図５－９にまとめました。


図５－９

この中で「.LockAspectRatio = ・・・」というのがありますが、これは「画像縦横比を固定するかの設定」です。値として「msoTrue」は画像比固定、「msoFalse」が固定せず　という設定になります。
「.LockAspectRatio = msoTrue」を設定すれば、縦横の片方を設定しさえすれば残りは自動的に決まります。逆にセルフィット時は「.LockAspectRatio = msoFalse」の設定が必須です。
この設定は、シート上で画像の書式設定を表示させて「縦横比の固定」をするか否かと同じ意味です。（図５－１０）

図５－１０

では、図５－９の中を見ていきます。
まず「セルフィット」は、無理やり選択範囲の形状に画像サイズを合わせますので、まずは「.LockAspectRatio = msoFalse」の設定を行います。
回転角が０度・１８０度の場合は見た目の通りですので「.WidthはSelection.Widthに」「.HeightはSelection.Heightに」合わせます。
残りの９０度・２７０度は、画像の.widthと.Heightが入れ替わっていますので、「.WidthはSelection.Heightに」「.HeightはSelection.Widthに」する必要があります。

次に「画像比維持」の場合ですが、図５－１１に示すように「選択範囲の方が縦長」の例で考えてみます。


図５－１１

まずは縦横比を固定するため「.LockAspectRatio = msoTrue」の設定をします。
回転角が０度・１８０度の場合は「.WidthはSelection.Widthに」合わせればサイズが決まります。
残りの９０度・２７０度は「.HeightはSelection.Widthに」すればＯＫです。

「選択範囲の方が横長」の場面は図にしていませんが、縦長の逆の設定をすれば良いことになります。

また「元の画像が縦長の場合は大丈夫？」と思われる方がいるかもしれません。それを検証したのが図５－１２です。

図５－１２

画像サイズの変更の式は、元画像の縦長・横長には無関係であることがわかると思います。

ということで、図５－９をプログラムコードにしたものが、２２～４９行目になります。

５－３－４．画像貼付け位置変更

サイズが決まったら、今度は貼付け位置です。
基準は、Leftを「Selection.Left」、Topを「Selection.Top」ですが、９０度・２７０度の時にはズレが発生します。

図５－１１と図５－１２の９０度・２７０度をもう一度見てください。「貼りたい位置（選択範囲の左上角）」と「画像の基準位置（図５－１１の赤丸）」にはズレがあります。
そのズレを修正するには、黄色矢印分だけ前後左右に「貼る位置を修正」してあげる必要があります。

今度はどれだけ動かせば良いかです。画像の回転は画像の中心点を中心に回りますので、例えば図５－１１の９０度では、
　・左右方向：（Width － .Height)/2　だけ左へ選択範囲をズラす。　→　Selection.Left - (Width - .Height)/2
　・上下方向：（Width － .Height)/2　だけ下へ選択範囲をズラす。　→　Selection.Top + (Width - .Height)/2
の修正をすれば良いことが分かります。これは２７０度でも全く同じです。

では次に図５－１２の「元画像が縦長」だった場合はどうでしょう。黄色矢印の方向が図５－１１とは逆になっています。しかし画像の縦横の寸法が逆転しているため、.Widthよりも.Heightの方が大きくなり、結果的には式の上では同じことになります。

図５－９の内容をコードにしたのが５１～５８行目になります。図５－９には３種の条件が入っていますのでコードも３重になります。図の一番左列がコードの一番外側に対応します。

５－４．標準モジュール

最後に、フォーム起動用のプロシージャを作成します。

62. '==========　⇩③　フォーム起動用プロシージャ　===========
63. Public Sub Pic_Paste()
64. 　UserForm1.Show 0　　　　 ’←モードレスでUserForm1を表示する
65. End Sub

図５－１３

６３行目は、アドインで起動できるようにPublicプロシージャにします。
また、ダイアログを表示させたまま選択範囲を変更できるように、フォームはモードレスで起動させます。
図５－１３を実行すると、図４－１の様にダイアログが立ち上がります。

５－５．拡張子による仕訳け

一応ここまでのマクロで「何のファイルでもシートに貼れる」「回転している画像も正しく貼れる」というものは出来ました。
しかし「画像ファイルは画像として貼れるが、それ以外はエラー画像になる」というものです。

このエラー（図５－５）を表示させなくする方法を調べてみたのですが、残念ながら分かりませんでした。
当初は、「.Shapes.AddPicture」で貼った画面が「エラー画像」なのだから「そのプロパティで拾えるのでは」と考え、探してみたのですが見つけることができませんでした。

ですので、図５－１４のように「URLで受け取ったファイル名の拡張子で仕訳ける」方法としました。

67. 　Dim aData As Variant ’←ﾌｧｲﾙ名をsplitで配列格納したもの
69. 　aData = Split(URL, ".")
70. 　・・・エラー処理・・・
71. 　Select Case UCase(aData(UBound(aData)))
72. 　　Case "JPG", "JPEG", "GIF", "BMP", "ICO", "RLE", "WMF", "EMF", "TIF", "TIFF", "PNG"
73. 　　　［　画像を貼り付け、サイズ・貼付け位置を変更するコード　］
74. 　　Case Else
75. 　　　MsgBox "未対応のファイルです"　　　　　 ’←UserForm2の仕様
76. 　　　［　OLEオブジェクト貼付けのコード　］　　 ’←UserForm3の仕様
77. 　End Select

図５－１４

拡張子の取得方法としては、６９行目の「Split(URL, ".")」で、パス名＋ファイル名を「.（ピリオド）」で文字列分割します。
分割したものは配列aDataに収められます。ファイル名の拡張子は「ファイル名の一番最後のピリオドのうしろ側」ですから、配列の最後の要素を取り出せば拡張子になるという訳です。
その手法の詳細は「画像を直接シートに貼り付ける」の「２－２－２－３項」を参照下さい。

その取り出した拡張子を「UCase関数で大文字に統一」させ、Select Case　で仕訳けて処理します。

Case Else に仕訳けられた場合は「画像ファイルではない」ことを意味します。
その場合、７５行目のようにコメントを出して終了しても良いですし、または「あらゆるデータファイルをシートに貼り付ける」のコードを貼り付けて、「画像は画像として、それ以外はアイコンとして貼り付ける」というアプリに仕立てても良いかと思います。（７６行目）

尚、一番下に添付したファイルでは、３つのフォームを作りました。内容としては以下の通りです。
　UserForm1 ： ファイル拡張子での仕訳けを行わず、画像以外はエラー画像が貼られる。
　UserForm2 ： 拡張子仕訳けをし、画像でないファイルは貼らない。
　UserForm3 ： 拡張子仕訳けをし、画像でないものはアイコンとして貼る。（画像以外は縦横比維持のみ）

３種は、標準モジュールのプロシージャで切り替えられるようにしておきます。既定はUserForm3としました。

６．Excelのアドインファイルにする

アドインへの登録方法については、下記を参照願います。ファイル名が異なるだけで手順は全く同じです。
・「セルの罫線を矢印キーで引く」
・「西暦・和暦対照表」

７．最後に

「画像を直接シートに貼り付ける」では回転させた画像の変形・位置ズレが発生し、その対策として作成したのが本項です。
回転うんぬん以前に、貼り付ける前にバイト解析等で画像サイズを求めるよりも、貼ったあとでサイズを整えた方が圧倒的に楽であることを実感しました。この方法で回転画像まで吸収できるのだったら、最初からこちらを狙えば良かったとも思いました。（PNG・Tiffファイルのバイト解析は楽しかったですが）
画像の回転については不可解なことがまだ多く、「画像の回転可否は何で決まっているのか」「JPEGには回転情報が入るのに、Tiffには何故回転情報が入らないのか」など興味深いものばかりです。
これ以上つっこむとExcelの枠を超えそうなので、ほどほどにしておきます。


回転させた画像をシートに貼り付ける（it-025.xlsm）

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始） 解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。