Unable To Set Chart Border

aayaanmayank

Board Regular
Joined
Jul 20, 2018
Messages
156
Hi Can someone tell what is wrong with my Code. problem is when debug code then i am getting desire border in my Image/Chart but it does not set border when hit through macro button. below is my entire code.
VBA Code:
Sub createcopy()
Dim sh As Worksheet
Dim lr As Variant
'Application.DisplayAlerts = False
Set sh = ThisWorkbook.Sheets("Template")
On Error GoTo Finish:
Worksheets("Template").Activate
lr = sh.Range("A" & Application.Rows.Count).End(xlUp).Row - 1

Worksheets("Template").Range("A1:Q" & lr).CopyPicture xlScreen, xlBitmap
Sheets("Sheet1").Activate
Sheets("Sheet1").PasteSpecial
'With Worksheets("Sheet1")
'End With
Call Export

Exit Sub
Finish:
MsgBox "Encountered Error Please Run Again.", vbCritical, "Talent Match"
Sheets("Template").Activate
End Sub

Sub Export()
Dim MyChart As String, MyPicture As String
Dim PicWidth As Long, PicHeight As Long
Dim shp As Shape
Dim ws As Worksheet
Dim cht As Chart
Set ws = ActiveSheet
For Each shp In ws.Shapes
If shp.Type = msoPicture Then
shp.Select
End If
Next shp

On Error GoTo Finish
MyPicture = Selection.Name
With Selection
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With

Charts.Add
'ActiveChart.HeightPercent = 100
'Legend.includeLayout = True
ActiveChart.Legend.IncludeInLayout = True
ActiveChart.Legend.Position = xlLegendPositionRight
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = xlContinuous

MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
strpath = Environ("USERPROFILE") & "\Desktop\"
With ActiveSheet
With .Shapes(MyChart)
.Width = PicWidth
.Height = PicHeight
End With
Dim cht As Chart

Set cht = Sheets("Sheet1").ChartObjects("Chart 1").Chart

' add plot area border
With cht.PlotArea.Border
.LineStyle = xlContinuous
.Weight = xlThick
End With

' add chart area border
With cht.ChartArea.Border
.LineStyle = xlContinuous
.Weight = xlThick

End With

.Shapes(MyPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export FileName:=strpath & "MyPic.bmp", Filtername:="bmp"
.Shapes(MyChart).Cut
End With
Application.ScreenUpdating = True
send1
Exit Sub
Finish:
MsgBox "Encountered Error Please Run Again.", vbCritical, "Talent Match"
Sheets("Template").Activate
End Sub

Sub send1()

Dim sh1 As Worksheet
Dim OLOOK As Outlook.Application
Dim omail As Outlook.MailItem
Dim ch As ChartObjects
Dim ws As Worksheet

Set sh1 = ThisWorkbook.Sheets("sheet1")
Set sh = ThisWorkbook.Sheets("Template")
Set OLOOK = New Outlook.Application
Set omail = OLOOK.CreateItem(olMailItem)
On Error GoTo Finish:
Set ws = ThisWorkbook.Sheets("Template")
tmp = Environ("USERPROFILE") & "\Desktop\" & "Mypic.Bmp"
With omail
omail.To = “”
omail.CC = “”
omail.Subject = “”
'omail.HTMLBody = "<BR> " & " <style=border: none>" & _
"<table align=""center"">" & _
"<img src = '" & tmp & "' >"
'omail.Attachments.Add tmp, 1, 0
omail.HTMLBody = "<html><BR><BR><center><img src = '" & tmp & "' ></center></BR></br></html>"
omail.Display
End With
sh1.Pictures.Delete
sh.Activate
Exit Sub
Finish:
MsgBox "Encountered Error Please Run Again.", vbCritical, "Talent Match"
Sheets("Template").Activate
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,223
Messages
5,768,903
Members
425,501
Latest member
sunderlalrwr

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
Top