| |
Excelのアドインを製作し、使ってもらっていたのですが、
その中の1人に急にエラーが発生するようになってしまいました
直そうにもこちらでは発生せず、相手は遠隔地にいるため、原因が特定できません･･･
構文的におかしい部分がありましたらご指導お願いします
機能
Excelのセルを選んだ状態でCTRL+Qを押すと画像選択画面が開き、
セルの大きさに合わせて画像を張り付けする
コードは標準モジュールに記入しています
エラー箇所と思われる場所
画像ファイルを選択した後にエラーが出て、デバッグを押すと
For Each mySP In ActiveSheet.Shapes
の部分がエラーを出している
For〜Nextをコメントアウトしたものを使用すると
Set mySP = ActiveSheet.Pictures.Insert(myF)
の部分でエラーが発生するらしい
ActiveSheetが取得できていない？
---以下内容----
Sub 画像貼付()
' Keyboard Shortcut: Ctrl+q
Application.ScreenUpdating = False
Cancel = True
'===============画像選択
myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF = False Then
Exit Sub
End If
'===============画像の掃除
For Each mySP In ActiveSheet.Shapes
myAD1 = mySP.TopLeftCell.MergeArea.Address
myAD2 = Selection.Address
If myAD1 = myAD2 Then mySP1.Delete
Next
'===============画像の貼り付け
Set mySP = ActiveSheet.Pictures.Insert(myF)
If vbYes = MsgBox("縦横比を維持しますか？", vbYesNo) Then
'===============タテヨコの縮尺を保持
myHH = Selection.Height / mySP.Height
myWW = Selection.Width / mySP.Width
If myHH > myWW Then
mySP.Height = mySP.Height * myWW
mySP.Width = Selection.Width
Else
mySP.Height = Selection.Height
mySP.Width = mySP.Width * myHH
End If
'===============中央へ調整
myHH2 = (Selection.Height / 2) - (mySP.Height / 2)
myWW2 = (Selection.Width / 2) - (mySP.Width / 2)
mySP.Top = Selection.Top + myHH2
mySP.Left = Selection.Left + myWW2
Else
mySP.Height = Selection.Height
mySP.Width = Selection.Width
End If
Set mySP = Nothing
Application.ScreenUpdating = True
End Sub
|
|
初心者
- 09/1/20(火) 18:28 -
