I have an almost perfect code for my objective that is to print a table into html format.
I'm missing two things:
1) there's one column that is filled with numbers in currency format (column 17). When I write it into html it looses its currency format and becomes plain text. I would like to add some code to change the printed content of the cells in that specific column into a text format that added commas in the currency format.
2) there are some cells where a list of things is displayed and separated with ";" or "; and". I would like to add a break into the html after this chars so that the next line would break below changing them to ";
" and "; and
". There's a catch here because since there are other html elements that end with ";" tha replacement must only occur in the section where I am writing the content of the table, not before, or else I would be changing elements in the CSS attributes.
I'll submit the code below. I thank you in advance for all your help.
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
Have you tried the Format Function? This might work for you although you might need to add some addition code to single out column 17 and apply the format as follows:
Format("1267.5", "Currency")
Result: '$1,267.50'
@Tim Williams threw me on the right path.
The final code for the #2 request is achieved by switching:
Print #1, Cells(iRow, iCounter).Value
With:
Print #1, Replace( Replace(Cells(iRow, iCounter).Value, "; and", "<br>"), ";", "<br>")
A replace inside another replace...
The rest of the code that was bogused is dismisable.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.