3

それで、コマンド ボタンにマクロを割り当てました。押すと、ユーザーが画像ファイルをインポートするためのダイアログ ボックスが開きます。次に、画像のサイズを変更し、特定のセルに配置します。しかし、元の画像ファイルの場所を移動すると、Excel で画像が消えてしまいます。元のファイルの場所を移動しても問題ないように、Excel ファイル内に保存できる可能性はありますか。

コードは次のとおりです。

    Sub Add_Image()
    Application.ScreenUpdating = False
    Range("B18").Select
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename("Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types
    On Error GoTo ErrMsg
    ActiveSheet.Pictures.Insert(Picture1).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 145
    Selection.ShapeRange.Width = 282
    Application.ScreenUpdating = True
    Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub
4

2 に答える 2

4

.Pictures.Insertリンクや埋め込みを制御できないようです。

ただし、代わりにこれを使用できます

expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

Sub Add_Image()
    Dim pic As Object
    Dim rng As Range

    Application.ScreenUpdating = False
    Set rng = Range("B18")
    Set rng2 = Range("A1", rng.Offset(-1, -1))
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename( _
        "Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types

    On Error GoTo ErrMsg
    With Range("A1", rng.Offset(-1, -1))
        Set pic = ActiveSheet.Shapes.AddPicture(Picture1, False, True, _
            .Width, .Height, 282, 145)
    End With
    With pic
        .LockAspectRatio = msoFalse
    End With
    Application.ScreenUpdating = True
Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub
于 2012-09-15T07:15:51.440 に答える
2

クリスの回答に加えて、ダウンロードした画像のアスペクト比を維持したかったのです。問題は、AddPicture メソッドが幅と高さの両方の引数を要求することでした。うまくいったトリックは、それらの値を「-1」にしてから、ロックされたアスペクト比で高さだけを変更することでした。

    Set picCell = cell.Offset(0, 1)

    Set pic = ActiveSheet.Shapes.AddPicture(fileString, False, True,_
          picCell.Left + 10, picCell.Top + 10, -1, -1)
    With pic
          .LockAspectRatio = msoTrue
          .Height = 200
    End With
于 2015-02-04T06:14:50.263 に答える