VBA Macro to Export Excel Named Range as a Picture to Target Folder
The following Macro will export the each Named Range like "MyRng*" as a image to the specified target folder.
Sub Export_Ranges_As_Images()
Dim Nam_Rng As Range
Dim RngExp As Range
Dim Nam as Name
K = 123456
For Each Nam In Names
If Nam.Name Like "MyRng*" Then
K = K + 1
Set RngExp = ThisWorkbook.Names(Nam.Name).RefersToRange
Set RngSht = ThisWorkbook.Sheets(RngExp.Parent.Name)
RngExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Set Tgt_Cht = RngSht.ChartObjects.Add(Left:=RngExp.Left, Top:=RngExp.Top, _
Width:=RngExp.Width, Height:=RngExp.Height)
With Tgt_Cht
.Name = "TempArea"
.Activate
End With
RngSht.ChartObjects("TempArea").Chart.Paste
RngSht.ChartObjects("TempArea").Chart.Export "C:\Users\Tamatam\Desktop\Temp\" & "Image_" & K & ".jpg"
RngSht.ChartObjects("TempArea").Delete
End If
Next
End Sub
------------------------------------------------------------------------------------------------------------------------------
Output :
The following Macro will export the each Named Range like "MyRng*" as a image to the specified target folder.
Sub Export_Ranges_As_Images()
Dim Nam_Rng As Range
Dim RngExp As Range
Dim Nam as Name
K = 123456
For Each Nam In Names
If Nam.Name Like "MyRng*" Then
K = K + 1
Set RngExp = ThisWorkbook.Names(Nam.Name).RefersToRange
Set RngSht = ThisWorkbook.Sheets(RngExp.Parent.Name)
RngExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Set Tgt_Cht = RngSht.ChartObjects.Add(Left:=RngExp.Left, Top:=RngExp.Top, _
Width:=RngExp.Width, Height:=RngExp.Height)
With Tgt_Cht
.Name = "TempArea"
.Activate
End With
RngSht.ChartObjects("TempArea").Chart.Paste
RngSht.ChartObjects("TempArea").Chart.Export "C:\Users\Tamatam\Desktop\Temp\" & "Image_" & K & ".jpg"
RngSht.ChartObjects("TempArea").Delete
End If
Next
End Sub
------------------------------------------------------------------------------------------------------------------------------
Output :
No comments:
Post a Comment
Hi User, Thank You for Visiting My Blog. Please Post Your Feedback/Comments/Query.