[[20141023200732]]　『VBAを修正したい（図の挿入をリンク扱いにしないａx（ささ）　ページの最後に飛ぶ

『VBAを修正したい（図の挿入をリンク扱いにしないようにしたい）』（ささ）

Excelで写真を大量に共有ファイルから挿入して貼り付けるファイルを
作っているのですが、他のPCで見るとリンクエラーとなり見れなくなってしまうので、
どこでも見れるようにリンク解除した状態で貼れるようにしたいのですが、
どのようにすればよいでしょうか。。　Shapes.Add メソッド？というものを
使えばよいというところまでわかったのですが、
vbaがほとんどわからないため、修正していただけると助かります。。

以下のvbaは、その編集しているExcelに入っていたもので、
結合されたセルをクリックすると挿入⇒図を選択するウィンドウが開きます。
また、ファイルサイズが" & MAXBYTE & "KBを超えています。　のメッセージが
容量に限らず出ないようにしたいのですが、その行をまるごと消していいものなのか
よくわかりません。。

ご教授お願いします。

Sub pasteImage()

    On Error GoTo ErrorProcess

    '１枚あたりの最大サイズ
    Dim MAXSIZE As Long
    Dim MAXBYTE As Long
    MAXBYTE = Range("O3").Value
    MAXSIZE = MAXBYTE * 1024

    Application.ScreenUpdating = False

    Dim filter
    filter = "画像 ファイル (*.jpg),*.jpg,画像 ファイル (*.bmp),*.bmp"
    Dim file
    file = Application.GetOpenFilename(filter, , , , False)

    If Not file = False Then

        Dim result As VbMsgBoxResult
        If FileLen(file) > MAXSIZE Then
            result = MsgBox("ファイルサイズが" & MAXBYTE & "KBを超えています。" & vbCrLf & "そのまま貼り付けますか？", vbYesNo)
            If result = vbNo Then
                Range("A1").Select
                Exit Sub
            End If
        End If

        With ActiveSheet
            With .Pictures.Insert(file)
                 .Left = Selection.Left + 1.25: .Top = Selection.Top + 1.25:
                 '.Width = .Width * 0.58
                 .Width = 370.5
                 '.Height = .Height * 0.58
                 .Height = 278.25
            End With
        End With

    End If

    Range("A1").Select
    Application.ScreenUpdating = True

    Exit Sub

ErrorProcess:

    MsgBox ("このファイルは貼り付けることができません")
    Range("A1").Select
End Sub

以上、よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 Sub pasteImage()
    Dim filter
    Dim file

    Application.ScreenUpdating = False

    filter = "画像 ファイル (*.jpg),*.jpg,画像 ファイル (*.bmp),*.bmp"
    file = Application.GetOpenFilename(filter, , , , False)

    If Not file = False Then
        ActiveSheet.Shapes.AddPicture _
            Filename:=file, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=Selection.Left + 1.25, _
            Top:=Selection.Top + 1.25, _
            Width:=370.5, _
            Height:=278.25
    End If

    Range("A1").Select
    Application.ScreenUpdating = True
End Sub
（???） 2014/10/24(金) 09:25

ありがとうございます。
問題なく動作できているようなので、
こちらを使わせていただこうと思います。
返答遅くなりすみません！
またよろしくお願いします！
（ささ） 2014/10/24(金) 17:43

コメント返信：

[ 一覧(最新更新順) ]

[[20141023200732]] 『VBAを修正したい（図の挿入をリンク扱いにしないａx（ささ） ページの最後に飛ぶ

[[20141023200732]]　『VBAを修正したい（図の挿入をリンク扱いにしないａx（ささ）　ページの最後に飛ぶ