[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2003の VBAを 2013でも 共に動作させたいのです』(kaze)
2003の画像貼り付けを 2010、2013共に動作させる 共通のVBAに変更したいのですが
よろしくお願いします。
Set Pic = ActiveSheet.Pictures.Insert(Fname)を 元画像を一度コピーして貼り付けにしましたが 動作不良になり 変更がわからないので 教えていただけますでしょうか。
元VBAです
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim Pic As Picture
On Error GoTo Err
If Target.Interior.ColorIndex <> 2 Then Exit Sub
If Target.MergeCells = False Then Exit Sub
Cancel = True
Const MF1 As String = "JPEG Files (*.jpg;*.jpeg;*.jpe),*.jpg;*.jpeg;*.jpe"
Const MF2 As String = "ビットマップ (*.bmp),*.bmp"
Const MF3 As String = "GIF (*.gif),*.gif"
Const MF4 As String = "すべてのファイル (*.*),*.*"
Fname = Application.GetOpenFilename(FileFilter:=MF1 & "," & MF2 & _
, & MF3 & "," & MF4)
If Fname = "False" Then
Exit Sub
End If
For Each Pic In ActiveSheet.Pictures
If Pic.TopLeftCell.MergeArea.Address = Target.Address Then
Pic.Delete
End If
Next
Set Pic = ActiveSheet.Pictures.Insert(Fname) ・・・←この変の修正で 全エクセルに対応できる変更を教えてくださいませ^^;
With ActiveSheet.Pictures(ActiveSheet.Pictures. _
Count).ShapeRange
.LockAspectRatio = msoFalse
.Parent.Visible = msoTrue
.Left = ActiveCell.MergeArea.Left
.Top = ActiveCell.MergeArea.Top
.Width = ActiveCell.MergeArea.Width
.Height = ActiveCell.MergeArea.Height
End With
Set Pic = Nothing
Exit Sub
Err:
MsgBox "エラー番号:" & Err.Number
MsgBox "エラー内容:" & Err.Description
End Sub
< 使用 Excel:Excel2013、使用 OS:Windows7 >対応
対応できましたので 削除しました^^
ありがとうございます
たしかオートシェープの指定方法についての質問だったような気がしますが、 質問者が削除してしまったようなので、迷宮入り防止にコメントだけします。
差分に残っている分だけ貼り付けますが、元の質問文を消して上書きしたよう で、残っていませんでした (Mook) 2014/04/07(月) 17:08
対応ありがとうございます。 たしかこんな質問でしたね。
どう解決したか書いてもらえると良かったのですが、
http://officetanaka.net/excel/vba/tips/tips87.htm
の書き方だと、バージョンが異なっても動いたような気が・・・(未確認)。
ActiveSheet.Pictures.Insert picFilePath With ActiveSheet.Pictures(1) 処理 End With
確かこのあたりが関係してるかなと思い、確認しようと思っているうちに消えて しまいました。 http://www.clayhouse.jp/vba/vba03.htm
(Mook) 2014/04/07(月) 19:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.