用Excel中的VBA替换html文件中的文本

时间:2017-10-27 20:04:15

标签: vba excel-vba excel

我有一个几乎完美的代码,我的目标就是将表格打印成html格式。

我错过了两件事:

1)有一列用货币格式填充数字(第17栏)。当我把它写入html时,它会丢失其货币格式并变为纯文本。我想添加一些代码来将特定列中单元格的打印内容更改为以货币格式添加逗号的文本格式。

2)有些单元格中显示了一系列事物,并用";"或&#34 ;;和&#34 ;.我想在这个字符之后添加一个中断的html,这样下一行就会破坏,将它们改为&#34 ;;
"和&#34 ;;和"。这里有一个问题,因为有其他html元素以&#34 ;;"结尾。替换必须只发生在我写表的内容的部分,而不是之前,否则我将改变CSS属性中的元素。

我将提交以下代码。我提前感谢你的帮助。

Sub CreateHTML()
  'Define your variables.
   Dim iRow As Long
   Dim tRow As Long
   Dim iStage As Integer
   Dim iCounter As Integer
   Dim iPage As Integer
   Dim lastCol As Integer
   Dim lastRow As Integer
   Dim repLine As Variant   'the array of lines you will WRITE
   Dim ln As Variant
   Dim l As Long

   'Find the last Column Number
    With ActiveSheet
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

   'Find the last Column Row
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

   'Create an .html file in the assigned directory.
   Dim sFile As Variant

    sFile = Application.GetSaveAsFilename(fileFilter:="HTML Files (*.html), *.htm")

    If fileName <> False Then
    SaveWorkbook = fileName
    End If

   'Open up the temp HTML file and format the header.
   Open sFile For Output As #1
   Print #1, "<html>"
   Print #1, "<head>"
   Print #1, "<style type=""text/css"">"
   Print #1, "table {font-size: 16px;font-family: Optimum, Helvetica, sans-serif; border-collapse: collapse}"
   Print #1, "tr {border-bottom: thin solid #A9A9A9;}"
   Print #1, "td {padding: 4px; margin: 3px; padding-left: 20px; width: 75%; text-align: justify;}"
   Print #1, "th { background-color: #A9A9A9; color: #FFF; font-weight: bold; font-size: 28px; text-align: center;}"
   Print #1, "td:first-child { font-weight: bold; width: 25%;}"
   Print #1, "</style>"
   Print #1, "</head>"
   Print #1, "<body>"

   'Translate the first column of the table into the first level of the hierarchy.
   tRow = 1

   'Start on the 2nd row to avoid the header. - iRow=2 / tRow is the table header
   For iRow = 2 To lastRow

   Print #1, "<table class=""table""><thead><tr class=""firstrow""><th colspan=""2"">Ficha de Risco</th></tr></thead><tbody>"

      For iCounter = 1 To lastCol

   Print #1, "<tr><td>"
   Print #1, Cells(tRow, iCounter).Value
   Print #1, "</td><td>"
   Print #1, Cells(iRow, iCounter).Value
   Print #1, "</td></tr>"

      Next iCounter
   Next iRow

   'Add ending HTML tags
   Print #1, "</body>"
   Print #1, "</html>"


   'after this comment the code is awfully wrong - please help!
   'Replace ; with ; <br> and ; and with ; and <br> - insert a breaking point after semicollon

   '# Read entire file into an array & close it
   repLine = Split(sFile.ReadAll, vbNewLine)

   '# iterate the array and do the replacement line by line
    For Each ln In repLine
    ln = IIf(InStr(1, ln, ";", vbTextCompare) > 0, Replace(ln, ";", "<br>"), ln)
    repLine(l) = ln
    l = l + 1
    Next

   '# Write to the array items to the file
   sFile.Write Join(repLine, vbNewLine)

   Close


End Sub

2 个答案:

答案 0 :(得分:0)

您是否尝试过格式化功能?这可能对你有用,虽然你可能需要添加一些附加代码来挑出第17列并按如下方式应用格式:

meps()

结果:&#39; $ 1,267.50&#39;

答案 1 :(得分:0)

@Tim Williams让我走上了正确的道路。

#2请求的最终代码是通过切换来实现的:

Print #1, Cells(iRow, iCounter).Value

使用:

   Print #1, Replace( Replace(Cells(iRow, iCounter).Value, "; and", "<br>"), ";", "<br>")

替换另一个替换......

其他被困的代码是可以理解的。