Excel2000 VBA 選択範囲をHTML表形式で出力

Excel2000 VBA　選択範囲をHTML形式で出力

Sub selection_save_html()
'
'選択範囲の左上のセルの値をファイル名にして、選択範囲を表HTMLとして出力する
'保存先はカレントフォルダ
'
Dim i, j As Integer
Dim d, SaveD As String
Dim start_row, start_column, end_row, rows_count, columns_count, end_column As Long
Dim File_name As String

'範囲を調べる
    start_row = Selection.ROW                               '開始行
    start_column = Selection.Column                         '開始列
    end_row = start_row + Selection.Rows.count - 1          '終了行
    end_column = start_column + Selection.Columns.count - 1 '終了列
    rows_count = Selection.Rows.count                       '範囲行数
    columns_count = Selection.Columns.count                 '範囲列数
   
'左上のセルの値をファイル名にする
    File_name = Cells(start_row, start_column).Value
   
'ファイルの読み込みと出力
    Open File_name & ".html" For Output As #1
SaveD = "<table border=1 cellspacing=0>" & vbCrLf
   
    For i = start_row To start_row + Selection.Rows.count - 1
        SaveD = SaveD & "<TR>" & vbCrLf
        For j = start_column To end_column
            d = "<td>" & Cells(i, j) & "</td>"
            SaveD = SaveD & d
            'Debug.Print SaveD
        Next j
        SaveD = SaveD & vbCrLf & "</TR>" & vbCrLf
    Next i
    SaveD = SaveD & vbCrLf & "</table>"
    'Debug.Print SaveD
    Print #1, SaveD
    Close #1
End Sub

---

Sub selection_save_html2()
'
'選択範囲の左上のセルの値をファイル名にして、選択範囲を表HTMLとして出力する
'保存先はカレントフォルダ
'実験バージョン２

Dim i, j As Integer
Dim SaveD As String
Dim d As String
Dim start_row, start_column, end_row, rows_count, columns_count, end_column As Long
Dim File_name As String
Dim myMsg As Variant
Dim cellD As Variant

myMsg = MsgBox("選択範囲をHTML形式で保存しますか？", vbYesNo, "HTMLで保存")
Select Case myMsg
    Case vbNo
        Exit Sub
    Case vbYes
    
End Select
        
'範囲を調べる
    start_row = Selection.ROW                               '開始行
    start_column = Selection.Column                         '開始列
    end_row = start_row + Selection.Rows.count - 1          '終了行
    end_column = start_column + Selection.Columns.count - 1 '終了列
    rows_count = Selection.Rows.count                       '範囲行数
    columns_count = Selection.Columns.count                 '範囲列数
    
'左上のセルの値をファイル名にする
    File_name = Cells(start_row, start_column).Value
    
'ファイルの読み込みと出力
    Open File_name & ".html" For Output As #1
SaveD = "<table border=1 cellspacing=0>" & vbCrLf
    
    For i = start_row To start_row + Selection.Rows.count - 1
        SaveD = SaveD & "<TR>" & vbCrLf
        For j = start_column To end_column
            cellD = Cells(i, j).Value
            If cellD = "" Then cellD = "　"
            'Debug.Print Cells(i, j).Value
            d = "<td>" & cellD & "</td>"
            
            SaveD = SaveD & d
            'Debug.Print SaveD
        Next j
        SaveD = SaveD & vbCrLf & "</TR>" & vbCrLf
    Next i
    SaveD = SaveD & vbCrLf & "</table>"
    'Debug.Print SaveD
    Print #1, SaveD
    Close #1
    
MsgBox File_name & ".html" & "でカレントフォルダに保存しました"

End Sub

 

タグ：Excel2000 VBA