How to use the Camera Icon Tool using a Macro?

all4excel

Active Member
Joined
Feb 15, 2008
Messages
435
How to use the Camera Icon Tool using a Macro?

I want to copy the First Row which is the Column heading of one Sheet to a different Sheet
Example :
From Col A till Col G First Row is to be copied as an Image..
Normally I do it using the Camera Icon, however when I tried recording a Macro for the same it did not work..

So how do I that if I provide the Start Column and End Column Alphabet as a Variable is that possible..
I want this Image to not remain Volatile which is the case using the Camera Tool..

So, how do i get the picture of only the first row or any row and store it is an Image in a different sheet as static picture so that even when the sheet is moved to a different location it does not make a difference to the Image.

Thanks in advance..
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Hi Kpark,

That was a very useful link, thanks a lot..
May I request you to please improvise the code futher as I dont know require prompts or Input Boxes but I need to pass direct addresses to the variables for collecting the information as well as for Pasting the Information.

Code:
Sub DoCamera()
    Dim MyPrompt As String
    Dim MyTitle As String
    Dim UserRange As Range
    Dim OutputRange As Range


    Application.ScreenUpdating = True


    'Prompt user for range to capture
    MyPrompt = "Select the range you would like to capture."
    MyTitle = "User Input Required"
    On Error Resume Next
    Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If UserRange Is Nothing Then End
    On Error GoTo 0


    'Copy range to Clipboard as picture
    UserRange.CopyPicture


    'Prompt user for range to paste to
    MyPrompt = "Select the range on which you would like to paste."
    MyTitle = "User Input Required"
    On Error Resume Next
    Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If OutputRange Is Nothing Then End
    On Error GoTo 0


    'Paste picture to output range
    OutputRange.PasteSpecial
    Selection.Formula = UserRange.Address ' I am getting error over here...in this line
End Sub


</pre>
Thanks in advance
all4excel
 
Last edited:
Upvote 0
Hi Kpark,

I modified the code myself however still require some help incase if I want to paste the Images slightly below the Top Edge.

Code:
Sub DoCamera()
    Dim MyPrompt As String
    Dim MyTitle As String
    Dim UserRange As Range
    Dim OutputRange As Range


    Application.ScreenUpdating = True




    Set UserRange = Worksheets("Sheet1").Range("A1:G1")
    If UserRange Is Nothing Then End
    On Error GoTo 0


    'Copy range to Clipboard as picture
    UserRange.CopyPicture




    On Error Resume Next
    Set OutputRange = Worksheets("Sheet1").Range("A6:G6")
    If OutputRange Is Nothing Then End
    On Error GoTo 0


    'Paste picture to output range
    OutputRange.PasteSpecial
    
    'Selection.Formula = UserRange.Address
    
End Sub
 
Upvote 0
Your code after removing redundant statements.
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Sub DoCamera()

    Dim UserRange As Range
    Dim OutputRange As Range

    Set UserRange = Worksheets("Sheet1").Range("A1:G1")
    UserRange.CopyPicture

    Set OutputRange = Worksheets("Sheet1").Range("A6:G6")
    OutputRange.PasteSpecial

End Sub[/COLOR][/SIZE][/FONT]
...I want to paste the Images slightly below the Top Edge
Which top edge?
 
Upvote 0
You know brother, I had done this however as there's some problem with my PC it did not get pasted earlier..
The Top Edge of the cells A2 till G2..
Please find my modified code..

Code:
Sub DoCamera()
    Dim UserRange As Range
    Dim OutputRange As Range


    Application.ScreenUpdating = True


' Macro written by Barrie Davidson
For Each Shape In ActiveSheet.Shapes
If Shape.Type = msoPicture Then
Shape.Delete
Else: Exit Sub
End If
Next Shape


    Set UserRange = Worksheets("Report").Range("A1:G2")
    If UserRange Is Nothing Then End
    On Error GoTo 0


    'Copy range to Clipboard as picture
    UserRange.CopyPicture




    On Error Resume Next
    Set OutputRange = Worksheets("Formatting").Range("A2:G3")
    If OutputRange Is Nothing Then End
    On Error GoTo 0


    'Paste picture to output range
    OutputRange.PasteSpecial
    
End Sub

I am getting an error saying that the variable "Shape" is not defined, now I am not sure what type i need that to be defined as I am using it from the net as you can see..

Now this is SUb Routine, can this type of code be modified to convert into a FUnction where I provide the InputCells Range and the OutputRange?

Something like this keeping the Name as :

ClickAndPaste(InputCellRng,OutputRng)

Thanks in advance..

Al-Humdallah
 
Upvote 0
There is no need to have a function as you are not expecting return value. Try this,
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Sub ClickAndPaste(ByVal rInputRng As Range, ByVal rOutputRng As Range)


    Dim shShape As Shape

    For Each shShape In ActiveSheet.Shapes
        If shShape.Type = msoPicture Then shShape.Delete
    Next shShape
    [COLOR="green"]' Copy range[/COLOR]
    rInputRng.CopyPicture
    [COLOR="green"]' Paste picture to output range[/COLOR]
    rOutputRng.PasteSpecial

End Sub[/COLOR][/SIZE][/FONT]
rOutputRng could be one cell only.
 
Upvote 0
Hey thanks, but when I am trying to use this I am getting the Macro Window Open and nothings happening..
Sorry for replying late, I was not aware that you had replied..

Al-Humdallah
 
Upvote 0
Since ClickAndPaste requires two parameters, then you have to call it from another macro in order to pass these parameters. You cannot call it from the Macros dialog box, as ClickAndPaste will not show there.

Here is an example on how to call ClickAndPaste,
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Sub ShowCamera()
    ClickAndPaste Range("A1:G3"), Range("A4")
End Sub[/COLOR][/SIZE][/FONT]
 
Upvote 0
Do you want the camera to show snapshot of data or you want it to act as a real camera that shows the changes in the data as well?
 
Upvote 0

Forum statistics

Threads
1,213,564
Messages
6,114,334
Members
448,567
Latest member
Kuldeep90

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top