Как сохранить форматирование в диапазоне отправки от Excel - PullRequest
Новая
       18

Как сохранить форматирование в диапазоне отправки от Excel

0 голосов
/ 07 июня 2019

Я довольно новичок в VBA и использую то, что мне удается, чтобы спасти то, что я нахожу в Интернете. У меня есть этот код ниже для отправки диапазона ячеек в виде вложения, и он в некоторой степени работает хорошо.

Проблема в том, что вложение Excel, созданное с помощью этого кода, не сохраняет форматирование (наиболее важно ширину столбцов)

Как я могу изменить код, чтобы сохранить исходное форматирование и ширину? 

 Sub SendRange()    
    Dim xFile As String
    Dim xFormat As Long
    Dim Wb As Workbook
    Dim Wb2 As Workbook
    Dim Ws As Worksheet
    Dim FilePath As String
    Dim FileName As String
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim WorkRng As Range
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Wb = Application.ActiveWorkbook
    Wb.Worksheets.Add
    Set Ws = Application.ActiveSheet
    WorkRng.Copy Ws.Cells(1, 1)
    Ws.Copy
    Set Wb2 = Application.ActiveWorkbook

    Select Case Wb.FileFormat
    Case xlOpenXMLWorkbook:
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    Case xlOpenXMLWorkbookMacroEnabled:
        If Wb2.HasVBProject Then
            xFile = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            xFile = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
    Case Excel8:
        xFile = ".xls"
        xFormat = Excel8
    Case xlExcel12:
        xFile = ".xlsb"
        xFormat = xlExcel12
    End Select

    FilePath = Environ$("temp") & "\"
    FileName = "MAB Taxi - " & Range("B1")
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat

    With OutlookMail
        .To = "email@email.com"
        .CC = ""
        .BCC = ""
        .Subject = "MAB Taxi - " & Range("B1")
        .Body = "hello, please check and read this document. "
        .Attachments.Add Wb2.FullName
        .Send
    End With

    Wb2.Close
    Kill FilePath & FileName & xFile
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    Ws.Delete

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
...