Wrap Square Image when exporting Outlook

[aayaanmayank]

Hi I have a excel which is combination of shapes and text boxes, after selecting shapes and text boxes, it creates an image through Macro. then its store the image in a location. after that this Image goes to outlook application. but few user not getting complete image. after doing WRAP SQUARE the are able to see complete image.
So is it possible to save image as WRAP SQUARE
Code to Create Image

Sub createcopy()
    Dim sh As Worksheet
    Dim lr As Variant
Application.DisplayAlerts = False
Set sh = ThisWorkbook.Sheets("Template")
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").Paste
Set myDocument = Worksheets("Sheet1")
myDocument.Shapes(1).PictureFormat.CropLeft = 1
myDocument.Shapes(1).PictureFormat.CropTop = 1
Call Export

CODE TO EXPORT & SAVE IMAGE IN BMP
[CODE=vba]
Sub Export()
     Dim MyChart As String, MyPicture As String
     Dim PicWidth As Long, PicHeight As Long
     Dim shp As Shape
     Dim ws As Worksheet
Set ws = ActiveSheet
For Each shp In ws.Shapes
    If shp.Type = msoPicture Then
        '        MsgBox shp.Name & " is a picture"
    shp.Select
    End If
Next shp
'     Application.ScreenUpdating = False
     On Error GoTo Finish
     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With
     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
    strpath = "D:\Users\Public\"
     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight              
           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 "You must select a picture"
End Sub

[/CODE]
CODE TO CREATE OUTLOOK WITH EMAIL.

Sub send1()
Dim sh1 As Worksheet
Set sh1 = ThisWorkbook.Sheets("sheet1")
Set sh = ThisWorkbook.Sheets("Template")
Dim OLOOK As Outlook.Application
Set OLOOK = New Outlook.Application
Dim omail As Outlook.MailItem
Set omail = OLOOK.CreateItem(olMailItem)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Template")
Dim ch As ChartObjects
Sheets("DL").Activate
LR1 = Sheets("DL").Range("A" & Rows.Count).End(xlUp).Row + 1
LR2 = Sheets("DL").Range("A" & Rows.Count).End(xlUp).Row + 1
    Set emailRng = Worksheets("DL").Range("A2:A" & LR1)
    Set emailRng1 = Worksheets("DL").Range("B2:B" & LR2)
    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next
    For Each cl1 In emailRng1
        sTo1 = sTo1 & ";" & cl1.Value
    Next
     sTo = Mid(sTo, 2)
     sTo1 = Mid(sTo1, 2)
With omail
omail.To = sTo
omail.CC = sTo1
omail.Subject = Sheets("DL").Range("C2").Value
omail.HTMLBody = "<BR> " & " <style=border: none>" & "<table align=""center"">" & "<img src = 'D:\Users\Public\MyPic.bmp'>"
omail.Display
End With
sh1.Pictures.Delete
sh.Activate
End Sub