S
Sam Kuo
Hi. I have these two subs to insert and delete drawing using command buttons,
but it doesn't seem to like how the Range is qualified here and causes
"run-time error 1004: application-defined or object-defined error".
I had a search in this forum, but still couldn't see what I've done wrong?
ps. I'm a VBA newbie...
Sam
Private Sub cbInsertImage_Click()
Const MY_PIC As String = "MyPic"
Dim MyWkSht As Worksheet
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double
Dim v
Dim s As OLEObject
Set MyWkSht = ThisWorkbook.Worksheets("B1")
Set ImageCell = MyWkSht.Range("B11").MergeArea
ImageCell.Select
v = Application.GetOpenFilename("Drawing Files (*.dwg),*.dwg")
If v = False Then Exit Sub
If Dir(v) = "" Then Exit Sub
MyWkSht.Unprotect (1)
Set s = MyWkSht.OLEObjects.Add(Filename:=v, Link:=False,
DisplayAsIcon:=False)
On Error Resume Next
MyWkSht.OLEObjects(MY_PIC).Delete
On Error GoTo 0
rH = ImageCell.Height: rW = ImageCell.Width
fH = s.Height / rH
fW = s.Width / rW
fMod = IIf(fH > fW, fH, fW)
With s
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With
With MyWkSht
.Hyperlinks.Add .Range("I32").MergeArea, v
.Range("I32").Font.Size = 8
.Range("I32").HorizontalAlignment = xlLeft
.Range("B10").Value = "Click DELETE button or CHANGE IMAGE button"
.Range("B32").Value = "Link to the above image" '**error 1004**
End With
cbInsertImage.Caption = "CHANGE IMAGE"
cbDeleteImage.Visible = True
cbDeleteImage.Enabled = True
MyWkSht.Protect (1)
End Sub
Private Sub cbDeleteImage_Click()
Const MY_PIC As String = "MyPic"
Dim MyWkSht As Worksheet
Dim Msg, Style, Title, Response, MyString
Dim s As String
Set MyWkSht = ThisWorkbook.Worksheets("B1")
MyWkSht.Unprotect (1)
Msg = "Are you sure to delete the image of the reference drawing?"
Style = vbYesNo + vbDefaultButton1
Title = "Warning"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
With MyWkSht
.Shapes(MY_PIC).Delete
.Range("B10").Value = "Click the INSERT IMAGE button"
.Range("B32").Value = "" '**error 1004**
.Range("I32").Value = "" '**error 1004**
End With
cbDeleteImage.Visible = False
cbInsertImage.Caption = "INSERT IMAGE"
Else
End If
MyWkSht.Protect (1)
End Sub
but it doesn't seem to like how the Range is qualified here and causes
"run-time error 1004: application-defined or object-defined error".
I had a search in this forum, but still couldn't see what I've done wrong?
ps. I'm a VBA newbie...
Sam
Private Sub cbInsertImage_Click()
Const MY_PIC As String = "MyPic"
Dim MyWkSht As Worksheet
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double
Dim v
Dim s As OLEObject
Set MyWkSht = ThisWorkbook.Worksheets("B1")
Set ImageCell = MyWkSht.Range("B11").MergeArea
ImageCell.Select
v = Application.GetOpenFilename("Drawing Files (*.dwg),*.dwg")
If v = False Then Exit Sub
If Dir(v) = "" Then Exit Sub
MyWkSht.Unprotect (1)
Set s = MyWkSht.OLEObjects.Add(Filename:=v, Link:=False,
DisplayAsIcon:=False)
On Error Resume Next
MyWkSht.OLEObjects(MY_PIC).Delete
On Error GoTo 0
rH = ImageCell.Height: rW = ImageCell.Width
fH = s.Height / rH
fW = s.Width / rW
fMod = IIf(fH > fW, fH, fW)
With s
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With
With MyWkSht
.Hyperlinks.Add .Range("I32").MergeArea, v
.Range("I32").Font.Size = 8
.Range("I32").HorizontalAlignment = xlLeft
.Range("B10").Value = "Click DELETE button or CHANGE IMAGE button"
.Range("B32").Value = "Link to the above image" '**error 1004**
End With
cbInsertImage.Caption = "CHANGE IMAGE"
cbDeleteImage.Visible = True
cbDeleteImage.Enabled = True
MyWkSht.Protect (1)
End Sub
Private Sub cbDeleteImage_Click()
Const MY_PIC As String = "MyPic"
Dim MyWkSht As Worksheet
Dim Msg, Style, Title, Response, MyString
Dim s As String
Set MyWkSht = ThisWorkbook.Worksheets("B1")
MyWkSht.Unprotect (1)
Msg = "Are you sure to delete the image of the reference drawing?"
Style = vbYesNo + vbDefaultButton1
Title = "Warning"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
With MyWkSht
.Shapes(MY_PIC).Delete
.Range("B10").Value = "Click the INSERT IMAGE button"
.Range("B32").Value = "" '**error 1004**
.Range("I32").Value = "" '**error 1004**
End With
cbDeleteImage.Visible = False
cbInsertImage.Caption = "INSERT IMAGE"
Else
End If
MyWkSht.Protect (1)
End Sub