Copy from Clipboard to Sheet and check for empty clipboard

[oldguy51]

Hi, first post and I would consider myself low range of intermediate user but not brand new.

I have a program that produces a picture output of data. I need to copy that picture to clipboard and then paste to a sheet to a defined cell as the upper left quadrant of the picture, it then resizes and pastes

The code to do all this works fine but if the user forgets to load the picture to clipboard nothing happens. I need to check the clipboard to see if data is there, if not produce error message to load picture to clipboard, then proceed. Also, if data is loaded I don't want the error code to appear, which is was for me.

First code is what works but will show error code if clipboard is empty or not.

Second code is my attempt to fix after reading many posts but my lack of experience has hacked that up.

Thank you for your time and thoughts,

Working Code:

Sub CopyPicX()
'
' CopyPicOpenFreq Macro
'
'
Sheets("Front Sign Off").Activate
ActiveSheet.Unprotect ("XXX")
On Error GoTo Opps 'Error Message Box
Range("Q45").Select
ActiveSheet.Paste
Selection.ShapeRange.LockAspectRatio = msoFalse 'allows to change size
Selection.ShapeRange.ScaleWidth 1.38, msoTrue, msoScaleFromTopLeft ' lock the aspect ratio (do not distort picture)
Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
Application.CutCopyMode = False ' clear the clipboard
ActiveSheet.Protect ("XXX")
Opps:
MsgBox ("You have not copied picture to clipboard yet!") 'Warning messege, then finishes macro
' GoTo Done
'Done:
End Sub


Hacked Code:

Sub CopyPicOpenFreq()
'
' CopyPicOpenFreq Macro
'
'
Dim DataObj As New MSForms.DataObject
Dim S As Picture 'Not sure what to call "S" here, was text but I am copying /pasting a picture


Sheets("Front Sign Off").Activate
ActiveSheet.Unprotect ("XXX")


DataObject.GetFromClipboard
S = DataObj.Getpicture


If Err.Number <> 0 Then
MsgBox ("You have not copied picture to clipboard yet!") 'Warning messege clipboard empty, then finishes macro
On Error GoTo 0
Exit Sub
End If

If Len(S) <> 0 Then
Range("Q45").Select
ActiveSheet.Paste
Selection.ShapeRange.LockAspectRatio = msoFalse 'allows to change size
Selection.ShapeRange.ScaleWidth 1.38, msoTrue, msoScaleFromTopLeft ' lock the aspect ratio (do not distort picture)
Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
Application.CutCopyMode = False ' clear the clipboard
ActiveSheet.Protect ("XXX")
End If

End Sub

 

[oldguy51]

Finally figured it out! Maybe will help others... By putting the line in to "Exit Sub" it stopped the normal execution of code until there was an empty clipboard.

Sub CopyPicOpenFreq()
'
' CopyPicOpenFreq Macro
'
'
Sheets("Front Sign Off").Activate
ActiveSheet.Unprotect ("rideMTV")
On Error GoTo Opps         'Error Message Box
    Range("Q45").Select
    ActiveSheet.Paste
    Selection.ShapeRange.LockAspectRatio = msoFalse 'allows to change size
    Selection.ShapeRange.ScaleWidth 1.38, msoTrue, msoScaleFromTopLeft          ' lock the aspect ratio (do not distort picture)
    Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
    Application.CutCopyMode = False                                             ' clear the clipboard
    ActiveSheet.Protect ("rideMTV")
Exit Sub    'This will stop normal execution of Error box unless there is an error
Opps:
   MsgBox ("You have not copied picture to clipboard yet!") 'Warning messege, then finishes macro
End Sub