Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　HTML形式で保存する
'
'  Copyright(C) 2000 Sunago
'
'　　このマクロを実行するには、Internet Assistant Wizardの機能を
'  インストールしておく必要があります。入手先は、MSOFFICEホームページの
'  ダウンロードページに用意されています。
'
'　HTMLconvert(RangeAndChartToConvert, _
'               UseExistingFile, _
'               UseFrontPageForExistingFile, _
'               AddToFrontPageWeb, CodePage, _
'               HTMLFilePath, _
'               [ExistingFilePath], _
'               [TitleFullPage], _
'               [HeaderFullPage], _
'               [DescriptionFullPage], _
'               [LineBeforeTableFullPage], _
'               [LineAfterTableFullPage], _
'               [LastUpdate], _
'               [NameFullPage], _
'               [EmailFullPage])
'
'　※[]付きの引数は省略可能です。
'
'   RangeAndChartToConvert
'       セル範囲又はChartオブジェクトを配列変数で指定する
'   UseExistingFile
'       True  := 指定したファイルに追加する
'       False := 新しいファイルを作成する
'   UseFrontPageForExistingFile
'       True  := FrontPage Web(URL)上にファイルがある
'       False := ローカル又はネットワーク上の共有フォルダにある
'   AddToFrontPageWeb
'       True  := FrontPage Web(URL)上にファイルに追加する
'       False := ローカル又はネットワーク上の共有フォルダにファイルを作成する
'   CodePage
'       <Windows>
'       1     := EUC
'       3     := JIS
'       932   := シフトJIS
'       <Macintosh>
'       10000 := 英語
'       10001 := 日本語
'   HTMLFilePath
'       出力先の絶対パス＋ファイル名又はURL(AddToFrontPageWebがTrueの場合)
'   ExistingFilePath
'       出力先の絶対パス＋ファイル名又はURL(UseFrontPageForExistingFileがTrueの場合)
'   TitleFullPage
'       タイトル(TITLEタグ)の文字を指定する
'   HeaderFullPage
'       ヘッダー(H1タグ)の文字を指定する
'   DescriptionFullPage
'       ヘッダーの説明を指定する
'   LineBeforeTableFullPage
'       True  := セル範囲の前に水平線を挿入する
'       False := 　　　〃　　　　　　　挿入しない
'   LineAfterTableFullPage
'       True  := セル範囲の後に水平線を挿入する
'       False := 　　　〃　　　　　　　挿入しない
'   LastUpdate
'       ページの下部に表示する最終更新日付を設定する
'   NameFullPage
'       ページの下部に表示する作成者の名前を設定する
'   EmailFullPage
'       ページの下部に表示するメールアドレスを設定する。

Sub Macro1()
Dim outfile As String
Dim Objects(1) As Variant
Dim sTitle As String
Dim sHeader As String
Dim sDescription As String
Dim ret

    '出力するファイル名を設定する
    If Right(ThisWorkbook.Path, 1) = "\" Then
        outfile = ThisWorkbook.Path & ActiveSheet.Name & ".html"
    Else
        outfile = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".html"
    End If
        
    Worksheets("Sheet1").Activate
    '出力するセル範囲、グラフを配列に格納する
    Set Objects(0) = ActiveSheet.ChartObjects("Chart 1")
    Set Objects(1) = ActiveSheet.Range("A15:G23")
    'タイトルを設定する
    sTitle = ThisWorkbook.Name
    'ヘッダーを設定する
    sHeader = ActiveSheet.Name
    '本文を設定する
    sDescription = "本文はここで指定する"
    
    'Internet Assistant Wizardのhtmlconvert関数をコールする
    ret = htmlconvert(Objects, False, False, False, 932, outfile, , _
            sTitle, sHeader, sDescription, True, , Now, "MyName", "MyMail@sunago.com")
    
    '正常終了時、ブラウザで表示する
    If CreateOK = 0 Then
        'Shell "START " & outfile
    Else
        MsgBox "HTML への変換に失敗しました。"
    End If
    

End Sub