投稿時間：2004/12/15(Wed) 02:48
投稿者名：しまりす
ＵＲＬ ：
タイトル：ExcelシートのＨＴＭＬ形式保存
いつも大変参考にさせて頂いております。
このたび不明な点がありまして御質問させて頂きます。
Excelのシートの印刷範囲をHTML形式で保存したいのですが、どのようにしたら良いのか
分かりません、どなたか御教授願えれば幸いです。
印刷・新規保存は出来ています。
HTML形式での保存方法が分かりません。
以下に現在のソースコードを添付します。
なにとぞよろしくお願い致します。
使用言語はVB6です。
Excelは2002です。
'
'リスト印刷
'
Private Sub Print1()
Dim i As Integer
Dim n As Integer
Dim buff As String
Dim myExcel As Object 'Workbook 'エクセルのブックオブジェクトへの参照を格納する変数
Dim myFileName As String '目的のファイルの名前
Dim svDir As String
Dim svFileNm As String
Dim svHtmlNm As String
Dim std As Date
Dim edd As Date
If List2.ListCount < 1 Then Exit Sub
svDir = App.Path & "\" & Tdata(1, 1).KojiNm
If dir(svDir, vbDirectory) = vbNullString Then MkDir svDir
svDir = svDir & "\" & Format(EndDate, "yyyy年")
If dir(svDir, vbDirectory) = vbNullString Then MkDir svDir
If TOption(0) Then
svDir = svDir & "\完了"
Else
svDir = svDir & "\" & Format(EndDate, "m月d日")
End If
If dir(svDir, vbDirectory) = vbNullString Then MkDir svDir
myFileName = App.Path & "\manu_17.xls"
Set myExcel = GetObject("", "Excel.Sheet")
DeleteFile App.Path & "\last.xls"
std = Tdata(1, 1).Nonyubi
i = Text2(1): If i < 1 Then i = 1
n = Text2(0) - (i * 100 - 100)
edd = Tdata(i, n).Nonyubi
With myExcel.Application
.ActiveWindow.WindowState = xlMaximized
.Workbooks.Open FileName:=myFileName
.range("C3") = "工事名称："
.range("D3") = Tdata(1, 1).KojiNm
.range("G57") = Page
For n = 1 To Val(Text2(1))
.Visible = False
.cells(5, 2) = n * 100 - 100 + 1
For i = 1 To 50
If Tdata(n, i).SeihinNm <> "" Then
.cells(i + 4, 3) = Tdata(n, i).SeihinNm
.cells(i + 4, 4) = Tdata(n, i).Dasetubi
.cells(i + 4, 5) = Tdata(n, i).Nonyubi
.cells(i + 4, 6) = Tdata(n, i).KojyoNm
Else
.cells(i + 4, 3) = ""
.cells(i + 4, 4) = ""
.cells(i + 4, 5) = ""
.cells(i + 4, 6) = ""
End If
Next
For i = 51 To 100
If Tdata(n, i).SeihinNm <> "" Then
.cells(i + 4 - 50, 8) = Tdata(n, i).SeihinNm
.cells(i + 4 - 50, 9) = Tdata(n, i).Dasetubi
.cells(i + 4 - 50, 10) = Tdata(n, i).Nonyubi
.cells(i + 4 - 50, 11) = Tdata(n, i).KojyoNm
Else
.cells(i + 4 - 50, 8) = ""
.cells(i + 4 - 50, 9) = ""
.cells(i + 4 - 50, 10) = ""
.cells(i + 4 - 50, 11) = ""
End If
Next
.range("F57") = CStr(n) & "/"
.Visible = True
If POption(0) Then .ActiveWindow.SelectedSheets.PrintOut Copies:=1, collate:=True
svHtmlNm = svFileNm
If TOption(0) Then
svFileNm = svDir & "\完了リスト" & "-" & CStr(n) & ".xls"
svHtmlNm = svDir & "\完了リスト" & "-" & CStr(n) & ".html"
Else
svFileNm = svDir & "\" & Format(EndDate, "m月") & "度リスト" & "-" & CStr(n) & ".xls"
svHtmlNm = svDir & "\" & Format(EndDate, "m月") & "度リスト" & "-" & CStr(n) & ".html"
End If
.DisplayAlerts = False
'EXCEL保存
.ActiveWorkbook.SaveAs FileName:=svFileNm
'HTML形式保存
'ここでHTML形式で保存したいのです。
.ActiveWorkbook.SaveAs FileName:=svHtmlNm
.Workbooks.Open FileName:=myFileName
.range("C3") = "工事名称："
.range("D3") = Tdata(1, 1).KojiNm
.range("G57") = Page
Next
.ActiveWorkbook.SaveAs FileName:=App.Path & "\last"
.Quit
End With
Set myExcel = Nothing
End Sub
|