.Shapes.Count not working (I think)

[Gl3n]

Hello all,

Below I've shared 'Sub PasteClip1()' that pastes whatever is in the clipboard (exc. text) into the position defined with cell F3 on the active sheet.
Now, this works fine up until the point that either of the other two subs pasted below that are run.
Following that, the 'With .Shapes(.Shapes.Count)' (after '.range("F3").Select' & '.Paste') and the subsequent position and size definitions do not work (although they don't throw an error), and then 'With .Shapes(.Shapes.Count).Select' does throw an error "Run-time error '-2147467259 (80004005)': Method 'Select' of object 'Shape' failed. This is with the error handler code commented out.

I don't think it's a sheet protection issue as I've tried with the sheet unprotected and 'Call ProtectSheet' commented out of all subs.
I don't think it's an 'ActiveSheet' issue as I've also tried using the sheet name and setting the active sheet using the sheet name.
Rightly or wrongly, what I'm inferring from this is Excel isn't detecting the pasted content as an object.

Here's the code:

Sub PasteClip1()

Dim answer As Integer

answer = MsgBox("Is the connector image copied to the clipboard?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then

Else
MsgBox "Copy the connector image to the clipboard before trying again."
Exit Sub
End If

aFmts = Application.ClipboardFormats
For Each fmt In aFmts
If fmt = xlClipboardFormatText Then
MsgBox "You cannot past text here."
Exit Sub
End If
Next

Call ProtectSheet

On Error GoTo ErrorHandler


With ActiveSheet
.Range("F3").Select
.Paste
With .Shapes(.Shapes.Count)
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.LockAspectRatio = msoFalse
.Width = 135
.Height = 95
End With

With .Shapes(.Shapes.Count).Select
Selection.ShapeRange.Name = "Device Connector"
End With

End With

answer = MsgBox("Would you like to keep the pasted image? Select Yes to continue or No to try again.", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then
Exit Sub
Else

With ActiveSheet
With .Shapes(.Shapes.Count)
.Delete
End With
End With

Exit Sub
End If

ErrorHandler:

MsgBox "Error - Ensure you have an image copied to the clipboard and try again. Contact team if problem persists."
Exit Sub

End Sub


And the code of the subs that break it:
Sub CreateCavities()


Dim LastRow As Long
Dim NewRow As Long
Dim i As Integer


If Not Range("B22").value = vbNullString Then
MsgBox "You can only create cavities once. Clear the form to try again."
Exit Sub
End If

If ActiveSheet.Range("D16").value = "0" Then
MsgBox "Connectors must be defined with at least one cavity!"
Exit Sub
End If

If Not IsNumeric(ActiveSheet.Range("D16").value) Then
MsgBox "You must populate the Harness Connector form before creating cavities!"
Exit Sub
End If

answer = MsgBox("Confirm total cavity quantity in this connector is " & ActiveSheet.Range("D16").value, vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then

Else
MsgBox "Re-enter cavity number in Harness Connector form."
Exit Sub
End If


Call ProtectSheet

On Error GoTo ErrorHandler

ScreenUpdating = False

Rows("19:21").Hidden = False

ScreenUpdating = False

cavity_count = ActiveSheet.Range("D16").value - 1

For i = 1 To cavity_count

With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
NewRow = LastRow + 1
Range("A" & LastRow, "AF" & LastRow).Select
Selection.AutoFill Destination:=Range("A" & LastRow, "AF" & NewRow), Type:=xlFillDefault
Range("A" & NewRow, "AF" & NewRow).Select
Selection.ClearContents
Range("A21", "C21:AF21").Locked = False
Range("A" & NewRow, "AF" & NewRow).Locked = False
Range("B" & NewRow).Locked = True
Range("B" & NewRow) = Range("B" & LastRow).value + 1
End With

Next i

ActiveSheet.Range("C21").Select

'ScreenUpdating = True

Exit Sub
ErrorHandler:
Rows("19:21").Hidden = True
MsgBox "Error - please check entries and try again."
Exit Sub


End Sub


Sub ClearCavityForm()

Dim LastRow As Long
Dim NewRow As Long
Dim FirstRow As Long

ScreenUpdating = False

Call ProtectSheet


If Range("B22").value = vbNullString Then
MsgBox "The form is already clear."
Exit Sub
End If


cavity_count = ActiveSheet.Range("D16").value - 1


With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
NewRow = LastRow + 1
FirstRow = LastRow - cavity_count
SecondRow = LastRow + 1 - cavity_count
Range("A" & FirstRow, "AF" & NewRow).Select
Selection.ClearContents
Range("A" & SecondRow, "AF" & NewRow).Select
Selection.Clear
Range("B21").value = "1"


End With

Rows("19:21").Hidden = True
ActiveSheet.Range("C21").Select


End Sub


Have fun!

 

[Gl3n]

If anyone else fall upon this, the reason for the issue is that drop downs in cells are counted as shapes.
The 'create cavities' sub shows a hidden drop down, which excel then attempts to include in the count.

The solution was to use variables (which I should've done before), and to use 'Like "Picture *" = False Then' to avoid counting the drop down.

If it will help anyone, here's the working code below:

Sub PasteClip1()

Dim answer As Integer
Dim shp As Shape
Dim ws As Worksheet

On Error GoTo ErrorHandler

Call ProtectSheet ' Calls a sub to protect the sheet from user interface interaction only

answer = MsgBox("Is the connector image copied to the clipboard?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then

Else
MsgBox "Copy the connector image to the clipboard before trying again."
Exit Sub
End If

aFmts = Application.ClipboardFormats
For Each fmt In aFmts
If fmt = xlClipboardFormatText Then
MsgBox "You cannot past text here."
Exit Sub
End If
Next


Set ws = ActiveSheet

With ws
.Range("F3").Select
.Paste
End With

With ws.Shapes
For Each shp In ws.Shapes
If shp.Name Like "Picture *" = False Then
Else
shp.Name = "Device Connector"
End If
Next shp

End With


With ws.Shapes
For Each shp In ws.Shapes
If shp.Name = "Device Connector" Then
shp.LockAspectRatio = msoFalse
shp.Width = 135
shp.Height = 95
End If
Next
End With

answer = MsgBox("Would you like to keep the pasted image? Select Yes to continue or No to try again.", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")

If answer = vbYes Then
Exit Sub
Else

With ws.Shapes
For Each shp In ws.Shapes
If shp.Name = "Device Connector" Then
shp.Delete
End If
Next
End With

Exit Sub
End If

ErrorHandler:

MsgBox "Error - please try again."
Exit Sub

End Sub