程序问答   发布时间:2022-05-31  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了在 HTML 中调整表格大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。

如何解决在 HTML 中调整表格?

开发过程中遇到在 HTML 中调整表格的问题如何解决?下面主要结合日常开发的经验,给出你关于在 HTML 中调整表格的解决方法建议,希望对你解决在 HTML 中调整表格有所启发或帮助;

老实说,我对 VBA 编程一无所知,但是,根据这个平台上的问题和答案,我整理了一个实际工作正常的代码(复制表格,创建并通过电子邮件发送并将表格粘贴到电子邮件)@H_301_1@

我需要帮助进行微调以实现以下结果:@H_301_1@

  1. A 列应包含 K 列的粘贴值(当我的 VBA 代码无法识别电子邮件地址时, 后面有VLOOKUP公式)
  2. 粘贴到电子邮件时隐藏 A 列和 K 列
  3. 在粘贴到电子邮件时优化列宽
  4. 将电子邮件发送给收件人后,将“已发送”放入 L 列

@H_197_17@

@H_301_1@@H_301_1@

这是代码:@H_301_1@

Option Explicit

Sub Test1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Dict As Object
    Dim cell As Range
    Dim cell2 As Range
    Dim rng As Range
    Dim i As Long
    Dim WS As Worksheet

    Application.Screenupdating = false
    Set OutApp = CreateObject("outlook.application")
    Set Dict = CreateObject("scripTing.Dictionary")
    Set WS = ThisWorkbook.Sheets("Hlavnat")
    
    On Error GoTo cleanup
    For Each cell In Ws.columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value like "?*@?*.?*" Then

                if Dict.exists(cell.value) = false Then

                Dict.Add cell.Value,""
                Set OutMail = OutApp.CreateItem(0)
                Set rng = WS.UsedRange.Rows(1)

                    For Each cell2 In WS.UsedRange.columns(1).Cells
                    If cell2.Value = cell.Value Then
                        Set rng = Application.Union(rng,WS.UsedRange.Rows(cell2.Row))
                    End If
                Next cell2
                
           
                
                On Error Resume Next
                With OutMail
                    .To = cell.Value
                    .Subject = "Navolané kontakty"
                    .HTMLBody = RangetoHTML(rng)
                    .display
                End With

                On Error GoTo 0
                Set OutMail = nothing
            End If
        End If
    Next cell

cleanup:
    Set OutApp = nothing
    Application.Screenupdating = True
End Sub

Function RangetoHTML(rng As RangE)

    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"

    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
        .Cells(1).SELEct
        Application.Cutcopymode = false
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.delete
        On Error GoTo 0
    End With

   
    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


    Set fso = CreateObject("ScripTing.fileSystemObject")
    Set ts = fso.Getfile(TempfilE).openAsTextStream(1,-2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = replace(RangetoHTML,"align=center x:publishsource=",_
                          "align=left x:publishsource=")

    
    TempWB.Close savechanges:=false

    Kill Tempfile
    
    Set ts = nothing
    Set fso = nothing
    Set TempWB = nothing
End Function

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)

大佬总结

以上是大佬教程为你收集整理的在 HTML 中调整表格全部内容,希望文章能够帮你解决在 HTML 中调整表格所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。
标签: