Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　Webページとして保存する
'
'  Copyright(C) 2000 Sunago
'
'　　EXCEL2000のシートの保存機能を使ってアクティブシートを
'  Webページとして保存します。アクティブシートをWebページとして
'  保存するには、SaveAsメソッドの引数FileFormatにxlHtmlを
'  指定します。
'  　SaveAsメソッドを使うと簡単にWebページとして保存することが
'  できますが、ブックごとWebページになってしまいます。そのため、
'  このマクロでは新規ブックを作成し、Webページとして保存したい
'  シートのみをコピーし、保存することで元ブックの形式を変更する
'  ことなくWebページを作成することができます。
'  　保存したWebページはブックと同じディレクリに"シート名.html"
'  という名前で作成します。このファイルをダブルクリックすると
'  保存内容を確認することができます。
'
'　※EXCEL専用のHTML式となっているため、IE5以外のブラウザでは
'  イメージどおりに表示できないことがあります。
'

Option Explicit

Sub Macro1()
Dim outfile As String
Dim bkTemp As Workbook

    'バージョンチェック
    If Ver9Check = False Then
        MsgBox "このバージョンのEXCELでは動作しません"
        Exit Sub
    End If
    '出力するファイル名を設定する
    If Right(ThisWorkbook.Path, 1) = "\" Then
        outfile = ThisWorkbook.Path & ActiveSheet.Name & ".html"
    Else
        outfile = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".html"
    End If
    '作業用に新規ブックを作成し、シート(Title)をコピーする
    Set bkTemp = Workbooks.Add
    ThisWorkbook.Sheets("Title").Copy Before:=bkTemp.Sheets(1)
    '作業用ブックにコピーしたシートをWeb(HTML)形式で保存する
    bkTemp.Sheets(1).SaveAs outfile, FileFormat:=44     'xlHtml(44)
    '作業用ブックを閉じる
    bkTemp.Close SaveChanges:=False
    
    '作成したWebページを表示する
    Shell "START " & outfile

End Sub

Private Function Ver9Check() As Boolean
Dim strver As String
    
    strver = Application.Version
    If Int(Left(strver, InStr(strver, "."))) < 9 Then
        Ver9Check = False
    Else
        Ver9Check = True
    End If

End Function