Seçilen alandan temel bir HTML tablosu oluşturur. Sonrasında çalışma sayfasının ismiyle bir html dosyası oluşturur ve bu tabloyu bu html dosyasına kaydeder.
Option Explicit
Sub SecilenAlandanHtmlTablosuOlusturVeTabloyuHtmlUzantiliDosyayaKaydet()
'--------------------------------------------------
'Değişkenler
'--------------------------------------------------
Dim t As String
Dim i, a As Integer
Dim j, b As Integer
Dim alan As Range
Dim fso As Object
Dim htmlDosyasi As Variant
Dim htmlDosyaMetni As String
'--------------------------------------------------
'Değer ata.
'--------------------------------------------------
a = 0
b = 0
'--------------------------------------------------
'HTML tablo oluştur.
'--------------------------------------------------
t = "<table border='1'>"
t = t & vbNewLine & Chr(9) & "<tr>"
For Each alan In Selection
If (b Mod Selection.Columns.Count) = 0 Then
t = t & Chr(9) & "</tr>" & vbNewLine & Chr(9) & "<tr>" & vbNewLine
End If
t = t & Chr(9) & Chr(9) & "<td>" & alan & "</td>" & vbNewLine
b = b + 1
Next
t = t & Chr(9) & "</tr>" & vbNewLine & "</table>"
'--------------------------------------------------
'HTML dosyası içeriğini hazırla.
'--------------------------------------------------
htmlDosyaMetni = _
"<!DOCTYPE html>" & vbNewLine _
& "<html>" & vbNewLine _
& "<head>" & vbNewLine _
& "<title>" & ThisWorkbook.Name & "</title>" & vbNewLine _
& "</head>" & vbNewLine _
& "<body>" & vbNewLine _
& t & vbNewLine _
& "</body>" & vbNewLine _
& "</html>"
'--------------------------------------------------
'HTML uzantılı dosya oluştur ve kaydet.
'--------------------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
Set htmlDosyasi = _
fso.CreateTextFile("D:\" & ThisWorkbook.Name & ".html", True, True)
htmlDosyasi.Write (htmlDosyaMetni)
htmlDosyasi.Close
End Sub