ワークシートへの画像の挿入はご注意を

何でもやってみないとわからないものですね。
Excelのワークシートに画像を挿入しようとした時のことです。サイズはセルの大きさにピッタリ合わせたいですよね。その際は下のコードが一般的です。

On Error Resume Next

With ActiveSheet.Pictures.Insert(FileName:="C:\test.jpg")
    .Top = TargetCell.Top
    .Left = TargetCell.Left
    .Width = TargetCell.Width
    .Height = TargetCell.Height
End With


ちなみにiPhoneで撮影した画像を貼り付けてみると、うまく挿入される画像もあるのですが、中にはTargetCellから大きく右へずれて、しかも少し大きめのサイズで貼りついてしまう画像があるじゃないですか。
これは画像の方に原因があるのではないかと思って調べてみると、右に大きくずれる画像は右方向に90度回転された画像だったのです。つまり、撮影した元画像をiPhoneが傾き補正した画像でした。

ここで問題を整理すると、次の2点になります。
1.狙ったセルから右に大きく離れた位置に貼りついてしまうこと。
2.縦・横のサイズ調整が逆になってしまうこと。

これを力技で修正したのが下のコードです。

On Error Resume Next

ActiveCell.Select

filePath = "C:\test.jpg"

ActiveSheet.Pictures.Insert(filePath).Select

If Application.WorksheetFunction.VLookup("Orientation", TargetCell, 2, False) < 5 Then
    If Selection.Width > ActiveCell.Width Or Selection.Height > ActiveCell.Height Then
        If Selection.Width / ActiveCell.Width > Selection.Height / ActiveCell.Height Then
            Selection.Height = Selection.Height * (ActiveCell.Width / Selection.Width)
            Selection.Width = ActiveCell.Width
        Else
            Selection.Width = Selection.Width * (ActiveCell.Height / Selection.Height)
            Selection.Height = ActiveCell.Height
        End If
    End If
Else
    If Selection.Width > ActiveCell.Height Or Selection.Height > ActiveCell.Width Then
        If Selection.Width / ActiveCell.Height > Selection.Height / ActiveCell.Width Then
            Selection.Height = Selection.Width * (ActiveCell.Width / Selection.Width)
            Selection.Width = ActiveCell.Height
        Else
            Selection.Width = Selection.Height * (ActiveCell.Height / Selection.Height)
            Selection.Height = ActiveCell.Widtht
        End If
    End If
End If


参照先:http://blog.livedoor.jp/hamu1962/archives/51519248.html
2017/08/17 コード再編集

ブログ気持玉

クリックして気持ちを伝えよう!

ログインしてクリックすれば、自分のブログへのリンクが付きます。

→ログインへ

なるほど(納得、参考になった、ヘー)
驚いた
面白い
ナイス
ガッツ(がんばれ!)
かわいい

気持玉数 : 0

この記事へのコメント