none
VBA Excelにて画像をファイルから挿入できるときと出来ないときがある RRS feed

  • 質問

  • VBAで、画像ファイルをセルに挿入する時に、挿入できるときと出来ないときがあります。

    初めは画像ファイルの容量が大きすぎるのかと思いましたが、違うようです。

    原因を探しているのですが、検討がつきません。

    画像ファイルの制限があって挿入できないのでしょうか?

    御存知の方がいらっしゃいましたら、何卒御教授願います。

    ・画像はどちらも同じカメラで撮影

    ・形式も同じ「jpeg」形式

    ・挿入できる画像:容量6MB

    挿入できない画像:容量3.5MB

    ・使用しているプログラム

     'ファイル名の挿入'
     If objFileName <> "" And flgA = 1 Then
           '基本シートへ画像の挿入'
                zahyo1.Select    '挿入するセルの指定'
                For Each gazou1 In kihonSH.Shapes
                    If gazou1.TopLeftCell.Address = zahyo1s Then gazou1.Delete   '削除する画像の座標指定'
                Next
                '画像の挿入'
                kihonSH.Unprotect Password:=rPATH
                tenpSH.Unprotect Password:=rPATH
                Set gazou1 = ActiveSheet.Shapes.AddPicture(Filename:=objFileName, _
                    LinkToFile:=False, _
                    SAVEWITHDOCUMENT:=True, _
                    Left:=Selection.Left, _
                    Top:=Selection.Top, _
                    Width:=0, _
                    Height:=0)
                With gazou1                     '一旦画像を元の大きさに戻す'
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                End With
                '''高さにあわせる'''
                kihonSH.Unprotect Password:=rPATH
                tenpSH.Unprotect Password:=rPATH
                With gazou1
                    .LockAspectRatio = True
                    .Width = ActiveCell.MergeArea.Height * (gazou1.Width / gazou1.Height)
                    .Height = ActiveCell.MergeArea.Height
                    .Placement = xlMove
                End With
                Call 画像圧縮
        End If

    Sub 画像圧縮()
    Dim Pic As Object
    Dim Ptop As Double, Pleft As Double
    For Each Pic In ActiveSheet.Pictures
        If TypeName(Pic) <> "OLEObject" Then
            Pic.Select
            Ptop = Pic.Top
            Pleft = Pic.Left
            Selection.Cut
            ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
            Selection.Left = Pleft
            Selection.Top = Ptop
        End If
    Next
    End Sub

    2018年12月6日 8:10

すべての返信

  • Excelのバージョンはいくつでしょうか? また、挿入できない画像は何度やっても挿入できないのでしょうか?
    第一印象として、基本的に画像によって挿入できないということは無いと思いますので、何かしらコードがうまく動作していないのではないかと思います。
    例えば画像の圧縮とかされているようですが、この工程を省いた場合は挿入されるのかなど、コードを少しずつ簡略しながらテストすると、原因の箇所が特定できるかもしれません。

    ★良い回答には質問者は回答済みマークを、閲覧者は投票を!

    2018年12月6日 9:22
    モデレータ
  • 早速の御回答ありがとうございます。

    画像の圧縮を行わない場合でも、画像が添付できませんでした。

    動作環境は「Win7Pro 64bit版」、「Oficce2013 32bit坂」です。

    2018年12月10日 2:24