こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA 特定のシートに同じ処理をさせたい

下記のプログラムはランキングをHTML化にしたものです。
シート名3つ
・スペシャルクラス
・オープンクラス
・ビギナークラス
で入力し、同時に処理したいと考えています。
https://excel-ubara.com/excelvba1r/EXCELVBA520.html

分からないことはHTML名で保存する処理です。
保存するファイル名 Sample.html
それを同時に保存する方法を教えてください。
スペシャルクラス.html
オープンクラス.html
ビギナークラス.html

Sub convertHTML()
Dim ws As Worksheet
Dim i As Long
Dim LineData As String
Dim Target As String

Target = ActiveWorkbook.Path & "\Sample.html"
Set ws = ThisWorkbook.Worksheets(1)
i = 1
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
LineData = ""
Do While Not (ws.Cells(i, 1).Value = "" And ws.Cells(i, 2).Value = "" And ws.Cells(i, 3).Value = "")
LineData = LineData & "<div>" & ws.Cells(i, 1).Value & "</div>" & vbCrLf
LineData = LineData & "<p>" & ws.Cells(i, 2).Value & "</p>" & vbCrLf
LineData = LineData & "<span>" & ws.Cells(i, 3).Value & "</span>" & vbCrLf
i = i + 1
Loop
.WriteText LineData, 1
.SaveToFile Target, 2
.Close
End With
MsgBox Target & "に書き出しました"
End Sub

投稿日時 - 2019-11-19 09:34:43

QNo.9680626

困ってます

質問者が選んだベストアンサー

こんな感じでしょうか。テスト未実施です。

Sub Sample1()
 Dim shtNM As Variant
 shtNM = Split("スペシャルクラス,オープンクラス,ビギナークラス", ",")
 Dim F As Integer
 
 Dim ws As Worksheet
 Dim i As Long
 Dim LineData As String
 Dim Target As String

 For F = 0 To UBound(shtNM)
  Target = ActiveWorkbook.Path & "\" & shtNM(F) & ".html"
  Set ws = ThisWorkbook.Worksheets(shtNM(F))
  ws.Activate
  i = 1
  With CreateObject("ADODB.Stream")
   .Charset = "UTF-8"
   .Open
   LineData = ""
   Do While Not (ws.Cells(i, 1).Value = "" And ws.Cells(i, 2).Value = "" And ws.Cells(i, 3).Value = "")
    LineData = LineData & "<div>" & ws.Cells(i, 1).Value & "</div>" & vbCrLf
    LineData = LineData & "<p>" & ws.Cells(i, 2).Value & "</p>" & vbCrLf
    LineData = LineData & "<span>" & ws.Cells(i, 3).Value & "</span>" & vbCrLf
    i = i + 1
   Loop
   .WriteText LineData, 1
   .SaveToFile Target, 2
   .Close
  End With
  'MsgBox Target & "に書き出しました"
 Next
End Sub

投稿日時 - 2019-11-19 10:47:33

お礼

コメントをありがとうございます。
うまくできました。

投稿日時 - 2019-11-19 14:10:42

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問