Sunday, 26 July 2015

How to Copy and Paste Excel Range as Picture in VBA

Excel VBA Macro to Copy an Excel Range as Picture and Pasting as Picture
Sub Copy_Paste_As_Picture()
'Method -I : Copying the Range as Picture and Pasting
'Selecting and Copying the Range
'ActiveSheet.Range(MyRange).Select

'Copying as Picture , Best Usage Method: This will copy the Range in Excel without Background
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Copying as Bit Map Image Method: This will copy the Range in Excel with Background
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

'Copying as Picture Print Method:
    Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture

    ThisWorkbook.Sheets("MyTab").Activate
    ActiveSheet.Range("A5").Select
    ActiveSheet.Paste
    
'Method - II : Copying the Range and Pasting as Picture
'Selecting and Copying the Range
ActiveSheet.Range(MyRange).Select
Selection.Copy

    ThisWorkbook.Sheets("MyTab").Activate
    ActiveSheet.Range("A5").Select

'Pasting as Picture
    ActiveSheet.Pictures.Paste
'Pasting as Picture with Source Link (The Source Tab & Range Address of the Image in Excel)
    ActiveSheet.Pictures.Paste(Link:=True).Select
    
End Sub

Saturday, 11 July 2015

How to Loop through Named Ranges in Excel

VBA Macro to Loop through Named Ranges in Excel
Sub Loop_Names()

Dim MyRng As Name

For Each MyRng In ThisWorkbook.Names

If InStr(MyRng.Name, "My_PPT") Then
'Displaying Range Name
MsgBox MyRng.Name
'Displaying the Range Reference
MsgBox MyRng.RefersToRange.Address
'Displaying the Range existed Sheet Name
MsgBox MyRng.RefersToRange.Parent.Name
End If

Next MyRng


End Sub

Friday, 10 July 2015

How to Copy a Named Range as a Picture from Target Excel File

VBA Macro to Copy a Named Range as a Picture from Target Excel File
Sub Copy_Named_Range_As_Picture()
Dim WS As Worksheet
Dim Tgt_File As Object
Dim MyTab as Object
Dim CopyRange as Object

Dim Src_Path As String
Dim Src_File As String
Dim RngName As String

Dim Tgt_Sht As String
Dim This_WB As Workbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False
   
   Set This_WB = ThisWorkbook
   Set MyTab = This_WB.Sheets("Graphs")

   Src_Path = This_WB.Sheets("CPanel").Range("A10").Value & "\"
   Src_File_Name = "Regional_Sales*.xls*" 

'Opening the Target file from the specified source Path
   Src_File = Dir(Src_Path & Src_File_Name)
   Set Tgt_File = Workbooks.Open(Src_Path & Src_File, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
    
        Application.Calculation = xlCalculationAutomatic   

'The Named Range which we want to Copy from Target Excel file.
            RngName = "Sales_Chart" 

'Defining the Target Named Range to Copy
            Set CopyRange = Tgt_File.Names(RngName).RefersToRange

'Getting Target Sheet name where the Named Range exists
            Tgt_Sht = Tgt_File.Names(RngName).RefersToRange.Parent.Name
            Tgt_File.Sheets(Tgt_Sht).Activate
            CopyRange.Select
            Selection.Copy
'Activating the Destination sheet and Pasting the copied Range as a Picture      
            MyTab.Activate
            ActiveSheet.Range("E5").Select
            ActiveSheet.Pictures.Paste.Select

Tgt_File.Activate
Tgt_File.Close

Set  CopyRange=Nothing
Set  This_WB=Nothing
Set   MyTab=Nothing

EndSub

How to Resize or Delete the Picture Objects in Excel

VBA Macro to Resize or Delete the Picture Objects in Excel Activesheet
Sub Resize_Picture_Objects()
Dim WS As Worksheet

Set WS = ActiveSheet
Dim Obj As Object
On Error Resume Next

For Each Obj In WS.Pictures

Obj.Select

With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Width = 650
.ShapeRange.Height = 300
End With

Next Obj

Set WS = Nothing

End Sub
----------------------------------------------------------------------------------------------------------
To Delete the Picture Objects in Excel Activesheet:
Sub Delete_Picture_Objects()
Dim WS As Worksheet

Set WS = ActiveSheet
Dim Obj As Object
On Error Resume Next

For K = 1 To 2
For Each Obj In WS.Pictures

Obj.Delete

Next Obj
Next K

Set WS = Nothing

End Sub

Saturday, 4 July 2015

VBA Macro to Select Multiple Ranges in Excel

How to Select Multiple Ranges , Rows , Columns in Excel with VBA
Sub Select_Multi_Rows_Cols_Ranges()

Dim WS As Worksheet

Set WS = ActiveSheet

'Selecting a Row 5
WS.Rows(5).Select

'Selecting a Rows 5 to 10
WS.Rows("5:10").Select

'Selecting Multiple Rows 5,7,9
WS.Range("5:5,7:7,9:9").Select

'Selecting Multiple Rows 5,7,9 by their Range_Names
WS.Range("Row_5,Row_7,Row_9").Select

'Selecting a Column 2
WS.Columns(2).Select
WS.Columns("B:B").Select

'Selecting a Columns 1 to 3
WS.Columns("A:C").Select

'Selecting Multiple Columns 1,3,5
WS.Range("A:A,C:C,E:E").Select

'Selecting Multiple Columns 1,3,5 by their Range_Names
WS.Range("Col_1,Col_3,Col_5").Select

'Selecting Multiple Ranges <A1:C5>,<B6:D10>
WS.Range("A1:C5,B6:D10").Select

'Selecting Multiple Ranges by their Range_Names
WS.Range("Range_123,Range_345").Select

'Defining Multiple Ranges
Set Rng1 = WS.Range("A2:B5")
Set Rng2 = WS.Range("D2:E5")
Set Rng3 = WS.Range("G2:H5")

'Union all the Ranges
Set Multi_Range = Union(Rng1, Rng2, Rng3)
Multi_Range.Select
Selection.Copy

WS.Range("K2").Select
WS.Paste

'Some Pastespecial Methods
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'Copy Pastes Method in Single Line
MyRng.Copy Destination:=Range("A2")
End Sub

Thanks,
TAMATAM

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts