Friday, 27 May 2016

VBA Macro to Save the Excel Range as Image

VBA Macro to Export Excel Range as Image to Clipboard
Sub Save_ExcelRange_As_Image()

Application.DisplayAlerts = False

Dim MyRange As Range
Dim NewChart As Chart

    Set MyRange = ThisWorkbook.Names("MyRng").RefersToRange

    ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count()),Type:=xlChart).Name = "MyChart"
            
        Set TgtChart = ThisWorkbook.Charts("MyChart")
        'ThisWorkbook.Sheets.Add(After:=Sheets("Data"),Type:=xlChart).Name = "MyChart"         
        'ActiveChart.SetSourceData Source:=Range("MyRng")

        MyRange.CopyPicture xlScreen, xlPicture
        TgtChart.Activate
        ActiveChart.Paste

        'ActiveChart.Delete
        'ActiveChart.ChartArea.Select
        'ActiveChart.PlotArea.Select

 'Formatting Copied Named Range on the Chart       
    Selection.ShapeRange.ScaleHeight 1.1, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.IncrementLeft 30
    Selection.ShapeRange.IncrementTop 125

'Exporting/Saving the Chart as a .jpg Image 
TgtChart.Export FileName:="C:\Users\Tamatam\Desktop\Temp\MyRange.jpg", Filtername:="JPG"

TgtChart.Delete
MsgBox "Target Range Saved as JPG Image", vbOKOnly, "Job Over"

End Sub

Wednesday, 25 May 2016

How to Rename the Files in Folder

VBA Macro to Rename the Excel Files in a Folder

Sub ReNameFiles()

Dim MyObj As Object, SrcDir As String, ObjFile As Object
   
SrcDir = ("C:\Users\Reddy\Desktop\Tamatam\Test\")

Set MyObj = CreateObject("Scripting.FileSystemObject")

 For Each ObjFile In MyObj.GetFolder(SrcDir).Files

   'Rename only the Excel Files   
        If InStr(ObjFile.Name, ".xls") = 0 Then Exit For
        
        If InStr(1, ObjFile.Name, "Dashboard") > 0 Then
                Pos = InStr(5, ObjFile.Name, "_")
            Else
                Pos = InStr(1, ObjFile.Name, "-")
        End If
        
        FilName = Left(ObjFile.Name, Pos - 1)
     
        ID = Trim(StrReverse(Right(Left(StrReverse(ObjFile.Name), 10), 5)))
        FY= "FY16"
        
        New_Name = FilName & "_" & FY & " - " & ID & ".xlsx"

   'Renaming the File
        ObjFile.Name = New_Name
    
  Next ObjFile    

End Sub

---------------------------------------------------------------------------------------------
Output  :

after renaming the files :




Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts