I've looked everywhere for an answer to this problem and found nothing that could help me fix it. What I find strange is that the code worked briefly before starting to return errors.
Basically, what I'm trying to do is to copy a picture from clipboard to a range, then resize it to fit into the range.
Here is the code:
Private Sub CommandButton1_Click()
Dim pct As Picture
ActiveSheet.Paste
Set pct = Selection
With ActiveSheet.Range("K10:W28")
pct.ShapeRange.LockAspectRatio = msoFalse
pct.Top = .Top
pct.Left = .Left
pct.Width = .Width
pct.Height = .Height
End With
End Sub
It is the line "ActiveSheet.Paste" that returns the error. I've tried replacing Paste with Paste Special or with PasteSpecial.xlPasteAll with the same result. Does anyone know why this happens? Thanks!
Private Sub CommandButton1_Click()
' Validate the active sheet.
If ActiveSheet Is Nothing Then
MsgBox "No visible workbooks open!", vbExclamation
Exit Sub
End If
If Not TypeOf ActiveSheet Is Worksheet Then
MsgBox "The active sheet is not a worksheet!", vbExclamation
Exit Sub
End If
' Create the worksheet and range references and select the first cell.
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rg As Range: Set rg = ws.Range("K10:W28")
Application.Goto rg.Cells(1)
' Paste.
Dim GotPasted As Boolean
On Error Resume Next
ws.PasteSpecial Format:="HTML"
GotPasted = (Err.Number = 0)
On Error GoTo 0
' Check if anything got pasted.
If Not GotPasted Then
MsgBox "Nothing pasted!", vbExclamation
Exit Sub
End If
' Check if a shape of type 'Picture' was pasted.
Dim shp As Shape: Set shp = ws.Shapes(ws.Shapes.Count)
If Not shp.Type = msoPicture Then
shp.Delete ' delete if not 'Picture'?
MsgBox "The pasted shape was no picture!", vbExclamation
Exit Sub
End If
' Reference and format the pasted picture.
Dim pic As Picture: Set pic = ws.Pictures(ws.Pictures.Count)
With rg
pic.ShapeRange.LockAspectRatio = msoFalse
pic.Top = .Top
pic.Left = .Left
pic.Width = .Width
pic.Height = .Height
End With
End Sub