Sub ExportToHTML(Filename As String, Rng As Range)
' Dim ws As Worksheet
Dim Filename As Variant
Dim TDOpenTag As String, TDCloseTag As String
Dim CellContents As String
Dim Rng As Range
Dim r As Long, c As Integer
' Open the text file
Open Filename For Output As #1
' Write the <TABLE> tag
Print #1, "<TABLE BORDER=1 CELLPADDING=3>"
' Loop through the cells
For r = 1 To Rng.Rows.Count
Print #1, "<TR>"
For c = 1 To Rng.Columns.Count
TDOpenTag = "<TD ALIGN=RIGHT>"
TDCloseTag = "</TD>"
If Rng.Cells(r, c).Font.Bold Then
TDOpenTag = TDOpenTag & "<B>"
TDCloseTag = "</B>" & TDCloseTag
End If
If Rng.Cells(r, c).Font.Italic Then
TDOpenTag = TDOpenTag & "<I>"
TDCloseTag = "</I>" & TDCloseTag
End If
CellContents = Rng.Cells(r, c).Text
Print #1, TDOpenTag & CellContents & TDCloseTag
Next c
Print #1, "</TR>"
Next r
' Close the table
Print #1, "</TABLE>"
' Close the file
Close #1
' Tell the user
MsgBox Rng.Count & " cells exported to " & Filename
End Sub
Sub EksportAsCSV_DK(strFileName As String, rngOmr As Range)
Const Delim As String = ";" 'afgrænser (delimiter)
Dim y As Long 'tæller
Dim x As Long 'tæller
Dim strTemp As String 'streng til de enkelte rækker
Dim lRows As Long 'antal rækker
Dim lCols As Long 'antal kolonner
Dim lFno As Long 'fil nummer
lFno = FreeFile
lRows = rngOmr.Rows.Count
lCols = rngOmr.Columns.Count
Open strFileName For Output As #lFno
For x = 1 To lRows
strTemp = ""
For y = 1 To lCols
strTemp = strTemp & rngOmr(x, y).Text
If y < lCols Then
strTemp = strTemp & Delim
Else
Print #lFno, strTemp
End If
Next
Next
Close #lFno
End Sub
