Sub myXlsLinesToHtmlPage()
  Rem セル行一括FrontPage転記/リンク集ページ作成処理
  Rem 記録者：Hitrock Camellia Shinopy
  Rem 言語：Excel VBA
  Rem 機能...
  Rem Excelの各行のデータをFrontPageに差し込んで、
  Rem リンク集のページを作成し、
  Rem HTML形式のファイルを書き込む。
  Rem 1行目は項目の見出し行とする。
  Rem A列にサイト名があるものとする。
  Rem B列にURLがあるものとする。
  Rem C列は、サイトの説明があるものとする。
  Rem D列は、空欄としておき、作成したHTML形式のファイル名を転記するものとする。
  Rem 注記...
  Rem   HTML形式のファイルの保存先フォルダを作成しておき、
  Rem   myWebFolderにパスを指定すること。
  Rem   myXlsLinesToHtmlPageを起動して使用。
  Rem 第1版： 2004/08/11：作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 参照設定：Microsoft FrontPage 5.0 Page Object Reference Library
  Rem 参照設定：Microsoft FrontPage 5.0 Web Object Reference Library
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myFrontPage As FrontPage.Application
  Dim myPageWindow As PageWindowEx
  Dim myDoc As FPHTMLDocument
  Dim myTheme As String
  '
  Dim myWebFolder As String
  Dim myFileName As String
  Dim myFileFullPath As String
  Dim myLine As Long
  Dim myClmn As Long
  Dim myText As String
  '
  '  保存先フォルダの指定
  myWebFolder = "C:\Documents and Settings\User" & _
      "\My Documents\My Webs\Zzz"
  '
  '  FrontPageの起動
  Set myFrontPage = CreateObject("FrontPage.Application")
  myFrontPage.ActiveWebWindow.Visible = True
  '
  ActiveSheet.Range("A1").Select
  myLine = 2
  '  ページの新規作成
  myFrontPage.ActiveWebWindow.PageWindows.Add
  Set myPageWindow = myFrontPage.ActivePageWindow
  Set myDoc = myFrontPage.ActivePageWindow.Document
  '
  myFileName = "\SubPage" & Format(Val(1), "000") & ".htm"
  myFileFullPath = myWebFolder & myFileName
  myDoc.Title = Cells(1, "A").Text
  '
  Do Until Cells(myLine, "A").Text = ""
    '  Excelのセルから新しいページにテキストを挿入
    myText = "<a href=" & Chr(34) & Cells(myLine, "B") & Chr(34) & ">" & Cells(myLine, "A")
    myText = myText & "</a><font size=" & Chr(34) & "2" & Chr(34) & "> "
    myText = myText & Cells(myLine, "C") & "</font>"
    Call myDoc.body.insertAdjacentHTML("BeforeEnd", "<p>" & myText & "</p>" & vbCrLf)
    '
    '  テーマの指定
    Rem myTheme = "citrus" ' [シトラス]
    Rem Call myPageWindow.ApplyTheme(myTheme, fpThemeVividColors) ' [鮮明な色]
    '
    '  書き出ししたファイル名をC列に転記する。
    Cells(myLine, "D").Value = myFileName
    myLine = myLine + 1
  Loop
  '
  '  HTML形式ファイルの書き出し
  myPageWindow.SaveAs myFileFullPath, True
  Rem myPageWindow.Close
  '
  Rem myFrontPage.Application.Quit
  Set myFrontPage = Nothing
  Set myPageWindow = Nothing
  Set myDoc = Nothing
End Sub  '  myXlsLinesToHtmlPage  *----*----*    *----*----*