請問可否插入圖檔時可以吻合儲存欄位大小 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 請問可否插入圖檔時可以吻合儲存欄位大小

返回列表下一主題上一主題發帖

[發問] 請問可否插入圖檔時可以吻合儲存欄位大小

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2014-10-27 15:41 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-10-27 15:43 編輯

回復 2# justinbaba

插入圖檔時可以吻合儲存欄位大小

有什麼方法可以大量的插入圖檔到儲存格之中

你的大量圖片在哪裡?
最好附範例檔上來

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2014-10-29 11:02 | 顯示全部帖子

回復 5# justinbaba
網頁上圈選照片,並拖曳到excel ,這XP做不到的,可以複製它然後貼到Excel上.(手動的複製)
請提供網頁的網址,及選照片的規則,用VBA來試試看

Sub Ex()
Dim P As Picture, URL As String
URL = "http://forum.twbts.com/attachments/month_1410/1410281446b4ab2b90bda703fc.jpg.thumb.jpg"
'指訂照片的網址
Set P = ActiveSheet.Pictures.Insert(URL) '物件(工作表上新增照片)
With Range("C5") '指定的儲存格
.RowHeight = 150 '調整儲存格高度
.ColumnWidth = 50 '調整儲存格寬度
P.Top = .Top '照片的左上方在工作表上的位置
P.Left = .Left '照片的右方在工作表上的位置
P.Height = .Height '照片的高度=儲存格的高度
P.Width = .Width '照片的寬度=儲存格的寬度
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2014-10-29 13:10 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-10-30 14:42 編輯

回復 7# justinbaba
反過來

Option Explicit
Sub Ex()
Dim P As Picture, URL As String
URL = "http://forum.twbts.com/attachments/month_1410/1410281446b4ab2b90bda703fc.jpg.thumb.jpg"
'指訂照片的網址
'ActiveSheet.Pictures.Delete '刪除所有的照片
Set P = ActiveSheet.Pictures.Insert(URL) '物件(工作表上新增照片)
With Range("C5") '指定的儲存格
P.Top = .Top '照片的右方在工作表上的位置
P.Left = .Left '照片的右方在工作表上的位置
.RowHeight = P.Height '調整儲存格高度=>照片的高度
.ColumnWidth = P.Width * (.ColumnWidth / .Width) '調整儲存格欄寬=>照片的寬度
'** 轉換 Width(點:像素)=ColumnWidth(寬度)
'ColumnWidth 一單位欄寬相當於一般樣式中的一個字元的寬度
'Width 屬性以點為單位傳回欄寬。
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2014-10-29 19:14 | 顯示全部帖子

回復 9# justinbaba

請提供網頁的網址,及選照片的規則,用VBA來試試看

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 唯其尊重自己的人，才更勇於縮小自己。

返回列表下一主題上一主題