Insert a screenshot picture at the active cell

 2021-04-29    Other    0    244

The macro below shows how you can take screenshot and insert it into a worksheet at the active cell position.
Optionally you can move or resize the inserted picture.

Sub ScreenClipping()
' updated 2021-04-29 by OPE
    Dim lngCount As Long
    lngCount = ActiveSheet.Shapes.Count ' count of existing shapes in the active worksheet
    CommandBars.ExecuteMso "ScreenClipping" ' inserts a screenshot at the active cell
    If lngCount >= ActiveSheet.Shapes.Count Then Exit Sub ' no new shape was added
    
    ' get the new shape object
    Dim objShape As Shape
    Set objShape = ActiveSheet.Shapes(lngCount + 1)
    
    ' move and resize the new shape
    With objShape
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        .ScaleHeight 0.75, msoFalse
        .ScaleWidth 0.75, msoFalse
    End With
End Sub