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
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
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.