ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Run-time error 1004 with Range (https://www.excelbanter.com/excel-programming/407260-run-time-error-1004-range.html)

Sam Kuo[_3_]
Run-time error 1004 with Range
 
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

Jim Thomlinson
Run-time error 1004 with Range
 
I see nothing specifically wrong with your code. So if you comment out those
lines everything works fine? Is there anything special about those cells that
you are trying to update?
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

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

Sam Kuo[_3_]
Run-time error 1004 with Range
 
Hi Jim.
1) Everything else in the two command button codes works fine (for now).
2) Those problem cells are no different to others.

But your questions remind me to check other subs in the same worksheet:
So I tried removing the "Private Sub Worksheet_Change" that follows the
command button codes and the two command button codes then work fine. But I
really need to keep all the codes to do my job...

Can you please help me spot where the problem is?


Private Sub Worksheet_Change(ByVal Target As Range)

' CHANGE INTERIOR COLOR OF CELLS
Dim MyWkSht As Worksheet
Dim b, c, e, p, q As Integer
Dim HighlightRange3 As Range
Dim HighlightRange4 As Range

Set MyWkSht = ThisWorkbook.Worksheets("B1")

b = 39
c = 13
e = 3

MyWkSht.Unprotect (1)

For p = 1 To 10

colNo3 = b + c * (p - 1) + e
colNo4 = colNo3 + 2

'Convert column number to text
colLetter3 = Left(Cells(1, colNo3).Address(0, 0), 1 - (Cells(1,
colNo3).Column 26))
colLetter4 = Left(Cells(1, colNo4).Address(0, 0), 1 - (Cells(1,
colNo4).Column 26))

Set HighlightRange3 = MyWkSht.Range(colLetter3 & "15 :" & colLetter4 & 15)

If MyWkSht.Range(colLetter4 & 14).Value < "" Then
HighlightRange3.Interior.ColorIndex = 36
HighlightRange3.Locked = False

Else
HighlightRange3.Interior.ColorIndex = xlNone
HighlightRange3.Locked = True

End If

For q = 1 To 15

Set HighlightRange4 = MyWkSht.Range(colLetter3 & 14 + q + 1 & ":" &
colLetter4 & 14 + q + 1)

If MyWkSht.Range(colLetter3 & 14 + q).Value < "" Or
MyWkSht.Range(colLetter4 & 14 + q).Value < "" Then
HighlightRange4.Interior.ColorIndex = 36
HighlightRange4.Locked = False

Else
HighlightRange4.Interior.ColorIndex = xlNone
HighlightRange4.Locked = True

End If

Next q

Next p

' CHANGE COMMAND BUTTONS CAPTION
If MyWkSht.Range("K33").Value = "" Then
cbInsertHyperlink.Caption = "INSERT"
cbDeleteHyperlink.Visible = False

Else
cbInsertHyperlink.Caption = "CHANGE"
cbDeleteHyperlink.Visible = True

End If

MyWkSht.Protect (1)

End Sub


"Jim Thomlinson" wrote:

I see nothing specifically wrong with your code. So if you comment out those
lines everything works fine? Is there anything special about those cells that
you are trying to update?
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

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

Jim Thomlinson
Run-time error 1004 with Range
 
How about disabling events?

Application.enableevents = false
'Make the changes
application.enableevents = true

Does your worksheet change code toggle the protection. If so then if you do
not disable events then you will need to turn protection off after each
change.
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

Hi Jim.
1) Everything else in the two command button codes works fine (for now).
2) Those problem cells are no different to others.

But your questions remind me to check other subs in the same worksheet:
So I tried removing the "Private Sub Worksheet_Change" that follows the
command button codes and the two command button codes then work fine. But I
really need to keep all the codes to do my job...

Can you please help me spot where the problem is?


Private Sub Worksheet_Change(ByVal Target As Range)

' CHANGE INTERIOR COLOR OF CELLS
Dim MyWkSht As Worksheet
Dim b, c, e, p, q As Integer
Dim HighlightRange3 As Range
Dim HighlightRange4 As Range

Set MyWkSht = ThisWorkbook.Worksheets("B1")

b = 39
c = 13
e = 3

MyWkSht.Unprotect (1)

For p = 1 To 10

colNo3 = b + c * (p - 1) + e
colNo4 = colNo3 + 2

'Convert column number to text
colLetter3 = Left(Cells(1, colNo3).Address(0, 0), 1 - (Cells(1,
colNo3).Column 26))
colLetter4 = Left(Cells(1, colNo4).Address(0, 0), 1 - (Cells(1,
colNo4).Column 26))

Set HighlightRange3 = MyWkSht.Range(colLetter3 & "15 :" & colLetter4 & 15)

If MyWkSht.Range(colLetter4 & 14).Value < "" Then
HighlightRange3.Interior.ColorIndex = 36
HighlightRange3.Locked = False

Else
HighlightRange3.Interior.ColorIndex = xlNone
HighlightRange3.Locked = True

End If

For q = 1 To 15

Set HighlightRange4 = MyWkSht.Range(colLetter3 & 14 + q + 1 & ":" &
colLetter4 & 14 + q + 1)

If MyWkSht.Range(colLetter3 & 14 + q).Value < "" Or
MyWkSht.Range(colLetter4 & 14 + q).Value < "" Then
HighlightRange4.Interior.ColorIndex = 36
HighlightRange4.Locked = False

Else
HighlightRange4.Interior.ColorIndex = xlNone
HighlightRange4.Locked = True

End If

Next q

Next p

' CHANGE COMMAND BUTTONS CAPTION
If MyWkSht.Range("K33").Value = "" Then
cbInsertHyperlink.Caption = "INSERT"
cbDeleteHyperlink.Visible = False

Else
cbInsertHyperlink.Caption = "CHANGE"
cbDeleteHyperlink.Visible = True

End If

MyWkSht.Protect (1)

End Sub


"Jim Thomlinson" wrote:

I see nothing specifically wrong with your code. So if you comment out those
lines everything works fine? Is there anything special about those cells that
you are trying to update?
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

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

Sam Kuo[_3_]
Run-time error 1004 with Range
 
Thanks Tim. Include disable events to all subs work for me - because I need
to turn on protection after running each sub to ensure locked cells remain
protected.

Really appreciate your kind help :-)

Sam


"Jim Thomlinson" wrote:

How about disabling events?

Application.enableevents = false
'Make the changes
application.enableevents = true

Does your worksheet change code toggle the protection. If so then if you do
not disable events then you will need to turn protection off after each
change.
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

Hi Jim.
1) Everything else in the two command button codes works fine (for now).
2) Those problem cells are no different to others.

But your questions remind me to check other subs in the same worksheet:
So I tried removing the "Private Sub Worksheet_Change" that follows the
command button codes and the two command button codes then work fine. But I
really need to keep all the codes to do my job...

Can you please help me spot where the problem is?


Private Sub Worksheet_Change(ByVal Target As Range)

' CHANGE INTERIOR COLOR OF CELLS
Dim MyWkSht As Worksheet
Dim b, c, e, p, q As Integer
Dim HighlightRange3 As Range
Dim HighlightRange4 As Range

Set MyWkSht = ThisWorkbook.Worksheets("B1")

b = 39
c = 13
e = 3

MyWkSht.Unprotect (1)

For p = 1 To 10

colNo3 = b + c * (p - 1) + e
colNo4 = colNo3 + 2

'Convert column number to text
colLetter3 = Left(Cells(1, colNo3).Address(0, 0), 1 - (Cells(1,
colNo3).Column 26))
colLetter4 = Left(Cells(1, colNo4).Address(0, 0), 1 - (Cells(1,
colNo4).Column 26))

Set HighlightRange3 = MyWkSht.Range(colLetter3 & "15 :" & colLetter4 & 15)

If MyWkSht.Range(colLetter4 & 14).Value < "" Then
HighlightRange3.Interior.ColorIndex = 36
HighlightRange3.Locked = False

Else
HighlightRange3.Interior.ColorIndex = xlNone
HighlightRange3.Locked = True

End If

For q = 1 To 15

Set HighlightRange4 = MyWkSht.Range(colLetter3 & 14 + q + 1 & ":" &
colLetter4 & 14 + q + 1)

If MyWkSht.Range(colLetter3 & 14 + q).Value < "" Or
MyWkSht.Range(colLetter4 & 14 + q).Value < "" Then
HighlightRange4.Interior.ColorIndex = 36
HighlightRange4.Locked = False

Else
HighlightRange4.Interior.ColorIndex = xlNone
HighlightRange4.Locked = True

End If

Next q

Next p

' CHANGE COMMAND BUTTONS CAPTION
If MyWkSht.Range("K33").Value = "" Then
cbInsertHyperlink.Caption = "INSERT"
cbDeleteHyperlink.Visible = False

Else
cbInsertHyperlink.Caption = "CHANGE"
cbDeleteHyperlink.Visible = True

End If

MyWkSht.Protect (1)

End Sub


"Jim Thomlinson" wrote:

I see nothing specifically wrong with your code. So if you comment out those
lines everything works fine? Is there anything special about those cells that
you are trying to update?
--
HTH...

Jim Thomlinson


"Sam Kuo" wrote:

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


All times are GMT +1. The time now is 08:20 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com