伊莉討論區

標題: Excel VBA 撰寫 : 網頁小說多頁讀取 [打印本頁]

作者: MarryHenry 時間: 2019-11-10 12:51 PM 標題: Excel VBA 撰寫 : 網頁小說多頁讀取

平日喜歡看 eyny 長篇小說消磨時間 ,
但又不想一直開著網路在 Web 上看 ,
Web 上也不方便調整習慣的字型字體 ,
所以用 Excel VBA 寫了個小程式 ,
一次讀取多頁 Web 文章 , 再 Copy 到自己偏好的記事本 , WordPad , Word , ...
調整好字型字體 , 慢慢欣賞

code

Sub 按鈕1_Click()
網頁讀取
End Sub
Sub 網頁讀取()
Application.DisplayAlerts = False
shN = ActiveSheet.Name
Rows("3:60000").ClearContents
Range("A3").Select

sh1 = Val(Cells(2, 3))
sh2 = Val(Cells(2, 4))

For sh = sh1 To sh2
      str31 = CStr(Cells(1, 7)) & sh & CStr(Cells(2, 7))

      Set ie = CreateObject("internetexplorer.application")    ' 使用此方式可以免除 "設定引用項目"
      With ie
         .Visible = False                                     ' True 為開啟 ie, False 為不開啟 ie
         .Navigate str31
         Do While .ReadyState <> 4                         ' 等待網頁開啟
            DoEvents
         Loop
         .ExecWB 17, 2                                        ' Select All
         .ExecWB 12, 2                                        ' Copy selection

         Sheets(shN).Select
         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

         ActiveCell.SpecialCells(xlLastCell).Select
         str32 = Selection.Address
         h1 = InStr(2, str32, "$")
         L2 = Right$(str32, Len(str32) - h1)
         Cells(L2 + 2, 2) = sh
         str33 = "A" & L2 + 2
         Range(str33).Select
      End With
      ie.Quit

Next sh
Application.DisplayAlerts = True
MsgBox ("~~~ ok ~~~")
str30 = "B3:B" & L2 + 2
Range(str30).Copy
End Sub

/code

作者: MarryHenry 時間: 2019-11-10 12:58 PM

呵呵 , 不好意思 ,
還不會使用如何將程式碼用[code][/code]包住 ,

[attach]129400629[/attach]

作者: Jeepluo 時間: 2019-12-6 04:07 PM

你也太神了，給你個讚，佩服你用vba寫

作者: MarryHenry 時間: 2020-3-1 08:30 AM

Jeepluo 發表於 2019-12-6 04:07 PM
你也太神了，給你個讚，佩服你用vba寫

謝謝您的回覆
VBA 是我的興趣

作者: zaq12345 時間: 2020-4-5 09:20 PM

謝謝大大的分享..大大辛苦了

作者: lexus0518 時間: 2020-4-15 11:37 AM

提示: 作者被禁止或刪除內容自動屏蔽

作者: erick883 時間: 2022-4-2 04:05 PM

超棒的~~~~~

歡迎光臨伊莉討論區 (http://www03.wahas.com/)