[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを修正したい(図の挿入をリンク扱いにしないようにしたい)』(ささ)
Excelで写真を大量に共有ファイルから挿入して貼り付けるファイルを
作っているのですが、他のPCで見るとリンクエラーとなり見れなくなってしまうので、
どこでも見れるようにリンク解除した状態で貼れるようにしたいのですが、
どのようにすればよいでしょうか。。 Shapes.Add メソッド?というものを
使えばよいというところまでわかったのですが、
vbaがほとんどわからないため、修正していただけると助かります。。
以下のvbaは、その編集しているExcelに入っていたもので、
結合されたセルをクリックすると挿入⇒図を選択するウィンドウが開きます。
また、ファイルサイズが" & MAXBYTE & "KBを超えています。 のメッセージが
容量に限らず出ないようにしたいのですが、その行をまるごと消していいものなのか
よくわかりません。。
ご教授お願いします。
Sub pasteImage()
On Error GoTo ErrorProcess
'1枚あたりの最大サイズ 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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.