通过自动调整将Excel范围发送到电子邮件正文 [英] Send Excel range into Email body with autofit

问题描述

我当前正在使用Ron de Bruin的RangetoHTML 函数进行发送电子邮件中有几张桌子.我想让这些表格自动适应Outlook中的屏幕.

I'm currently using Ron de Bruin's RangetoHTML function to send a couple of tables out in an e-mail. I'd like to have these tables auto-fit to the screen in outlook.

当前，我必须单击每个表并转到layout-> autofit以在每个表上进行屏幕显示.我想知道是否可以以某种方式将此任务折叠到宏中.

Currently, I have to click on each table and go to layout->autofit to screen on each table. I was wondering if this task could be folded into the macro in some way.

这是我对解决方案的第一个猜测:

This was my first guess at a solution:

objMail.HTMLBody = RangetoHTML(Range("A1:G14")) & _
    RangetoHTML(Range(Range("vmRange").Value)) & _
    RangetoHTML(Range(Range("hpRange").Value)) & _
    RangetoHTML(Range(Range("esrRange").Value))

For Each tbl In objMail.body.tables
    tbl.Columns.AutoFit 'Note: This doesn't actually work
Next tbl

推荐答案

这是我对Ron de Bruin函数的修改版本:

Here's my modified version of Ron de Bruin's function:

Function RangetoHTMLFlexWidth(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTMLFlexWidth = ts.readall
    ts.Close
    RangetoHTMLFlexWidth = Replace(RangetoHTMLFlexWidth, "align=center x:publishsource=", _
        "align=left x:publishsource=")

    Dim startIndex As Long
    Dim stopIndex As Long
    Dim subString As String

    'Change table width to "100%"
    startIndex = InStr(RangetoHTMLFlexWidth, "<table")
    startIndex = InStr(startIndex, RangetoHTMLFlexWidth, "width:") + 5
    stopIndex = InStr(startIndex, RangetoHTMLFlexWidth, "'>")
    subString = Left(RangetoHTMLFlexWidth, startIndex)
    subString = subString & "100%"
    RangetoHTMLFlexWidth = subString & Mid(RangetoHTMLFlexWidth, stopIndex)

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

更改以注释开头:

'Change table width to "100%"

它只是找到定义表格宽度的位置并将其设置为100％.浏览器或Outlook将单元格缩放到新的宽度，因此可以完成工作，但这是一个肮脏的技巧，IMO.

It just finds the spot where the table's width is defined and sets it to 100%. The browser or outlook scales the cells to the new width, so it does the job, but it's a dirty hack, IMO.

这篇关于通过自动调整将Excel范围发送到电子邮件正文的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！