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
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