Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4245 / 13646 ツリー ←次へ | 前へ→

【57691】htmlにリンクをはりたいのですが ちず 08/9/9(火) 21:36 質問[未読]
【57692】Re:htmlにリンクをはりたいのですが かみちゃん 08/9/9(火) 21:39 発言[未読]
【57693】Re:htmlにリンクをはりたいのですが ちず 08/9/9(火) 22:24 発言[未読]
【57695】Re:htmlにリンクをはりたいのですが かみちゃん 08/9/10(水) 0:00 発言[未読]
【57728】Re:htmlにリンクをはりたいのですが ちず 08/9/10(水) 21:44 お礼[未読]

【57691】htmlにリンクをはりたいのですが
質問  ちず  - 08/9/9(火) 21:36 -

引用なし
パスワード
   こんばんは。

下記にマクロを二つ書きました。

ひとつはフォルダ下にあるファイルの内容(NO、NAME,TEL)を
ひとまとめにするマクロ。

もうひとつのマクロはまとめたデータをHTMLにし、
NOのところにリンクをはろうとするものです。
リンク先は転記した元ファイルです。

たとえば
フォルダ-サブフォルダ−111.xls
           −222.xls 

111.xls内は
NO NAME TEL
111 田中 012−3456−7890

まとめのシートには
NO  NAME TEL
111 田中 012‐3456‐7890
222 山田 123-3456‐1234


ここの各NOにリンク。
111のリンク先は111.xls、222のリンク先は222.xlsを
開けたいのですが書き方に悩んでおります。
どう書けばよいのかよいのでしょうか。
よろしくお願いいたします。

Sub test()
Dim myfso As New filesystemobject
Dim fld As folder
Dim flname As FileDialog
Dim thebk As Workbook
Dim i As Long
Dim LROW As Long

With myfso.getfolder(ThisWorkbook.Path & "\")
For Each fld In .subfolders
  For Each flname In fld.Files
  Set thebk = Workbook.Open(ThisWorkbook.Path & "\" & myfld.Name & "\" & flname.Name)
    For i = 1 To 3
     LROW = .Cells(65536, 1).End(xlUp).Row + 1
     ThisWorkbook.Sheets("まとめ").Cells(LROW, i) = thebk.Sheets("Sheet1").Cells(i + 2, 2)
    Next
  Next
Next
thebk.Close savechanges:=False
End With

End Sub


Sub test2()
Dim FNO As Integer
Dim sname As String
Dim AROW As Long
Dim hani As Range
Dim z,y As Long

FNO = FreeFile
sname = ThisWorkbook.Path & "\" & "作成.html"

Open sname For Output As #FNO

Print #FNO, "<html><head><title></title></head>"
Print #FNO, "<body>"
Print #FNO, "<table><tr>"
Print #FNO, "<td>NO</td><td>NAME</td><td>TEL</td>"
Print #FNO, "</tr>"

AROW = Workbook("まとめ").Cells(65536, 1).End(xlUp).Row
Set hani = Workbook("まとめ").Range(Cells(1, 1), Cells(AROW, 3))

For z = 1 To hani.Rows.Count
 For y = 1 to 3
  Print #fso, "<tr>"
  Print #fso, "<td>" & "hani.cells(z,y).value" & "</td>"
  Print #fso, "</tr></table></body></html>"
 Next 
Next
End Sub

【57692】Re:htmlにリンクをはりたいのですが
発言  かみちゃん  - 08/9/9(火) 21:39 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>どう書けばよいのかよいのでしょうか。

よく見ていないのですが、
 Print #fso, "<td>" & "hani.cells(z,y).value" & "</td>"
の部分の
hani.cells(z,y).value
の前後にある " はいらないような感じがします。

MsgBox "hani.cells(z,y).value"
MsgBox hani.cells(z,y).value
としてみて、表示内容の違いを確認してみてください。

【57693】Re:htmlにリンクをはりたいのですが
発言  ちず  - 08/9/9(火) 22:24 -

引用なし
パスワード
   ▼かみちゃん さん:
お返事ありがとうございます。

>>どう書けばよいのかよいのでしょうか。
>
>よく見ていないのですが、
> Print #fso, "<td>" & "hani.cells(z,y).value" & "</td>"
>の部分の
>hani.cells(z,y).value
>の前後にある " はいらないような感じがします。
>
>MsgBox "hani.cells(z,y).value"
>MsgBox hani.cells(z,y).value
>としてみて、表示内容の違いを確認してみてください。

書き間違えてしまいました。
申し訳ありません。
hani.cells(z,y).valueという文字列になってしまいますね。

【57695】Re:htmlにリンクをはりたいのですが
発言  かみちゃん E-MAIL  - 08/9/10(水) 0:00 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 111のリンク先は111.xls、222のリンク先は222.xlsを
> 開けたいのですが書き方に悩んでおります。
> どう書けばよいのかよいのでしょうか。

さきほどは、よく見ていなかったのですが、サンプルファイルを用意して、コード
を試してみると、提示のコードでは不具合箇所がたくさんありました。

一応以下のようにすると、ご希望のことはできると思います。

なお、まとめシートのD列には、リンク先ファイルのフルパスを作業データとして
転記するようにしています。

しかし、ファイル一覧をシートに作成せずにいきなり、作成.htmlファイルを作成
することもできます。(test1_1とtest2_1を分ける必要がない)

Sub test1_1()
 Dim myfso As New filesystemobject
 Dim fld As Folder
 Dim flname As File
 'Dim flname As FileDialog
 Dim thebk As Workbook
' Dim i As Long
' Dim LROW As Long

 With myfso.getfolder(ThisWorkbook.Path & "\")
  For Each fld In .subfolders
   For Each flname In .Files
    If UCase(flname.Path) <> UCase(ThisWorkbook.FullName) Then
     Set thebk = Workbooks.Open(flname.Path)
     With ThisWorkbook.Sheets("まとめ")
'      LROW = .Cells(65536, 1).End(xlUp).Row + 1
'      For i = 1 To 3
'       ThisWorkbook.Sheets("まとめ").Cells(LROW, i) = thebk.Sheets("Sheet1").Cells(2, i)
'      Next
      With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
       .Resize(, 3).Value = thebk.Sheets("Sheet1").Cells(2, 1).Resize(, 3).Value
       .Offset(, 3).Value = flname.Path
      End With
     End With
     thebk.Close savechanges:=False
    End If
   Next
  Next
 End With
 MsgBox "まとめデータを作成しました"
End Sub

Sub test2_1()
 Dim FNO As Integer
 Dim sname As String
' Dim AROW As Long
 Dim hani As Range
 Dim z As Long, y As Long

 FNO = FreeFile
 sname = ThisWorkbook.Path & "\" & "作成.html"

 Open sname For Output As #FNO

 Print #FNO, "<html><head><title></title></head>"
 Print #FNO, "<body>"
 Print #FNO, "<table><tr>"
 Print #FNO, "<td>NO</td><td>NAME</td><td>TEL</td>"
 Print #FNO, "</tr>"

' AROW = Worksheets("まとめ").Cells(65536, 1).End(xlUp).Row
' Set hani = Worksheets("まとめ").Range(Cells(1, 1), Cells(AROW, 3))
 With Worksheets("まとめ")
  Set hani = Worksheets("まとめ").Range("A1", .Cells(Rows.Count, 1).End(xlUp))
 End With
 For z = 1 To hani.Rows.Count
  Print #FNO, "<tr>"
  For y = 1 To 3
   If y = 1 Then
    Print #FNO, "<td>" & StrConv("<a href=", vbNarrow) & _
     """file://" & hani.Cells(z, 4).Value & """>" & hani.Cells(z, y).Value & "</td>"
   Else
    Print #FNO, "<td>" & hani.Cells(z, y).Value & "</td>"
   End If
  Next
  Print #FNO, "</tr>"
 Next
 Print #FNO, "</tr></table></body></html>"
 Close #FNO
 MsgBox "Htmlファイルを作成しました。" & vbCrLf & sname
End Sub

※StrConv("<a href=", vbNarrow)
 の部分は、掲示板投稿時に、自動変換されしまう語句であるようですので、
 わざと全角で記述して半角に変換するコードにしています。
 したがって、実際の記述の際には、" "内を半角文字で直接記述しても構いません。

【57728】Re:htmlにリンクをはりたいのですが
お礼  ちず  - 08/9/10(水) 21:44 -

引用なし
パスワード
   ▼かみちゃん さん:

ありがとうございます!
ファイルパスを書きだして・・
という方法は浮かびませんでした。
勉強になりました。

追記:
複数ファイル→HTMLにすることもできました。

4245 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free