- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
12#
發表於 2014-10-30 16:21
| 只看該作者
回復 11# justinbaba
抓電腦 D:\PIC 可參考 這裡的第 5 帖
Google 家 圖片的範例- Option Explicit
- Sub Ex_網頁下載照片()
- Dim i As Integer, E As Object, P As Picture, Sh As Worksheet, MaxWidth As Single
- Set Sh = ActiveSheet '指定工作表
- Sh.Pictures.Delete '刪除所有的照片
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate "https://www.google.com/search?tbm=isch&hl=zh-TW&source=hp&q=%E5%AE%B6&gbv=2&oq=%E5%AE%B6&gs_l=img.12...0.0.0.1844.0.0.0.0.0.0.0.0..0.0....0...1ac..34.img..0.0.0.9S-XuJpg9JY"
- '.Navigate 指定的網頁有照片
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- With .Document
- For Each E In .all
- If UCase(E.tagname) = "IMG" Then
- i = i + 1
- Set P = Sh.Pictures.Insert(E.href) '物件(工作表上新增照片)
- With Sh.Cells(i, "a") '指定的儲存格
- P.Top = .Top '照片的右方在工作表上的位置
- P.Left = .Left '照片的右方在工作表上的位置
- .RowHeight = IIf(P.Height >= 409, 409, P.Height) '調整儲存格高度=>照片的高度
- P.Height = IIf(P.Height >= 409, 409, P.Height) '調整儲存格高度=>照片的高度
- If MaxWidth < P.Width * (.ColumnWidth / .Width) Then '下載照片的最大寬度
- MaxWidth = P.Width * (.ColumnWidth / .Width)
- .ColumnWidth = P.Width * (.ColumnWidth / .Width) '調整儲存格欄寬=>照片的寬度
- End If
- End With
- End If
- Next
- End With
- For Each P In Sh.Pictures
- P.Width = Sh.Cells(i, "a").Width '調整所有的照片寬度一致
- Next
- .Quit '關閉網頁
- End With
- End Sub
|
|
發表於 2014-10-30 14:19
| 
