Board logo

標題: [發問] 請問可否 插入圖檔時可以吻合儲存欄位大小 [打印本頁]
作者: justinbaba    時間: 2014-10-24 15:25     標題: 請問可否 插入圖檔時可以吻合儲存欄位大小

請問各位網兄

因為我的工作常常要在製作Excel 表格時，要從網路上拖曳圖檔 還是  插入圖檔到 儲存欄位中
有時一天存個幾十張圖，都要調整大小並設定屬性為大小位置隨儲存格而變，非常的花時間。

有二個問題想要尋求解答

一、 有什麼方法可以大量的插入圖檔到儲存格之中，依序的按列排好，並不用再進行調整呢？
二、 樞紐分析是否可以連圖也一起顯示出來呢？

我目前使用的是  office 2010  的版本.
作者: justinbaba    時間: 2014-10-27 14:25

請問有高手可以解惑嗎？ 非常感謝..
作者: GBKEE    時間: 2014-10-27 15:41

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

回復 2# justinbaba
插入圖檔時可以吻合儲存欄位大小
參考這理

有什麼方法可以大量的插入圖檔到儲存格之中
你的大量圖片在哪裡?
最好附範例檔上來
作者: justinbaba    時間: 2014-10-28 15:40

目前想要做出的來功能為

[attach]19412[/attach]
[attach]19413[/attach]
[attach]19414[/attach]

抱歉，因為我完全沒有VBA 的基礎.. 會再努力K書的..
而有位善心的網友給我一段程式碼.. 但是我試著去key in 後, 好像並沒有成功 ..
再附上我作的excel 檔.. 請網兄們幫小的看看問題出在那呢？   是我那邊執行上有錯誤嗎？？
[attach]19415[/attach]
  1. Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
  2. Dim p As Object
  3. If Dir(PictureFileName) = "" Then Exit Sub
  4. Set p = ActiveSheet.Pictures.Insert(PictureFileName)
  5. With TargetCells
  6. p.Top = .Top
  7. p.Left = .Left
  8. .ColumnWidth = .ColumnWidth / .Width * p.Width
  9. .RowHeight = p.Height
  10. End With
  11. Set p = Nothing
  12. End Sub
複製代碼
  1. Sub TestInsertPictureInCell()
  2. On Error Resume Next
  3. For i = 1 To 10
  4. InsertPictureInRange "C:\Temp\Pic" & i, Range("A" & i)
  5. Next i
  6. End Sub
複製代碼
作者: justinbaba    時間: 2014-10-28 15:53

抱歉~~ 剛才的照片 沒有加上註解..

第一張
圈選照片,並拖曳到excel 儲存格中

第二張
擺放到儲存格中的照片會自動變成 "隨儲存格大小而變"
不需要再進行調整及設定

第三張
某網頁上的照片也可以透過拖曳到儲存格後，完成跟前面步驟一樣的狀態
作者: GBKEE    時間: 2014-10-29 11:02

回復 5# justinbaba
網頁上圈選照片,並拖曳到excel ,這XP做不到的,可以複製它然後貼到Excel上.(手動的複製)
請提供 網頁的網址,及選照片的規則,用VBA來試試看
  1. Sub Ex()
  2.     Dim P As Picture, URL As String
  3.         URL = "http://forum.twbts.com/attachments/month_1410/1410281446b4ab2b90bda703fc.jpg.thumb.jpg"
  4.         '指訂照片的網址
  5.     Set P = ActiveSheet.Pictures.Insert(URL)  '物件(工作表上新增照片)
  6.     With Range("C5")        '指定的儲存格
  7.         .RowHeight = 150    '調整儲存格高度
  8.         .ColumnWidth = 50   '調整儲存格寬度
  9.         P.Top = .Top        '照片的左上方在工作表上的位置
  10.         P.Left = .Left      '照片的右方在工作表上的位置
  11.         P.Height = .Height  '照片的高度=儲存格的高度
  12.         P.Width = .Width    '照片的寬度=儲存格的寬度
  13.     End With
  14. End Sub
複製代碼
作者: justinbaba    時間: 2014-10-29 12:00

回復  justinbaba
網頁上圈選照片,並拖曳到excel ,這XP做不到的,可以複製它然後貼到Excel上.(手動的複製) ...
GBKEE 發表於 2014-10-29 11:02


GBKEE 大您好... 再請教一下.. 您給我的這段程式碼是針對照片的調整嗎？
是否也能把儲存格自動調整到吻合照片的大小呢？
[attach]19425[/attach]
作者: GBKEE    時間: 2014-10-29 13:10

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

回復 7# justinbaba
反過來
  1. Option Explicit
  2. Sub Ex()
  3.     Dim P As Picture, URL As String
  4.         URL = "http://forum.twbts.com/attachments/month_1410/1410281446b4ab2b90bda703fc.jpg.thumb.jpg"
  5.         '指訂照片的網址
  6.        'ActiveSheet.Pictures.Delete '刪除所有的照片
  7.     Set P = ActiveSheet.Pictures.Insert(URL)  '物件(工作表上新增照片)
  8.     With Range("C5")            '指定的儲存格
  9.         P.Top = .Top            '照片的右方在工作表上的位置
  10.         P.Left = .Left          '照片的右方在工作表上的位置
  11.         .RowHeight = P.Height    '調整儲存格高度=>照片的高度
  12.         .ColumnWidth = P.Width * (.ColumnWidth / .Width)   '調整儲存格欄寬=>照片的寬度
  13.         '** 轉換 Width(點:像素)=ColumnWidth(寬度)
  14.         'ColumnWidth 一單位欄寬相當於一般樣式中的一個字元的寬度
  15.         'Width 屬性以點為單位傳回欄寬。
  16.     End With
  17. End Sub
複製代碼
作者: justinbaba    時間: 2014-10-29 18:21

回復  justinbaba
反過來
GBKEE 發表於 2014-10-29 13:10


好像成功了~~ 那再請問一下，程式碼要怎麼改，才能讓我在電腦端插入的圖檔可以 適用在 每一個欄位呢？
抱歉 @@ 真的要再加油才行
作者: GBKEE    時間: 2014-10-29 19:14

回復 9# justinbaba
請提供 網頁的網址,及選照片的規則,用VBA來試試看
作者: justinbaba    時間: 2014-10-30 14:19

本帖最後由 justinbaba 於 2014-10-30 14:21 編輯
回復  justinbaba
GBKEE 發表於 2014-10-29 19:14


Dear GBKEE 大

我比較 常用的規則 都是  抓電腦 D:\PIC
或是抓 FB 上粉絲團的照片 如.  
https://fbcdn-sphotos-a-a.akamaihd.net/hphotos-ak-xfa1/v/t1.0-9/10606582_848432645189022_612134465661955873_n.jpg?oh=72c345140a00525c75d0b30adafc29db&oe=54E93E5E&__gda__=1425326606_ac6b4e067fc55726650a4dd598d05494
作者: GBKEE    時間: 2014-10-30 16:21

回復 11# justinbaba
抓電腦 D:\PIC 可參考 這裡的第 5 帖  

Google 家 圖片的範例
  1. Option Explicit
  2. Sub Ex_網頁下載照片()
  3.     Dim i As Integer, E As Object, P As Picture, Sh As Worksheet, MaxWidth As Single
  4.     Set Sh = ActiveSheet      '指定工作表
  5.     Sh.Pictures.Delete        '刪除所有的照片
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True
  8.         .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"
  9.         '.Navigate 指定的網頁有照片
  10.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  11.         With .Document
  12.             For Each E In .all
  13.                If UCase(E.tagname) = "IMG" Then
  14.                     i = i + 1
  15.                     Set P = Sh.Pictures.Insert(E.href) '物件(工作表上新增照片)
  16.                     With Sh.Cells(i, "a")               '指定的儲存格
  17.                         P.Top = .Top                    '照片的右方在工作表上的位置
  18.                         P.Left = .Left                  '照片的右方在工作表上的位置
  19.                         .RowHeight = IIf(P.Height >= 409, 409, P.Height)        '調整儲存格高度=>照片的高度
  20.                         P.Height = IIf(P.Height >= 409, 409, P.Height)          '調整儲存格高度=>照片的高度
  21.                         If MaxWidth < P.Width * (.ColumnWidth / .Width) Then    '下載照片的最大寬度
  22.                             MaxWidth = P.Width * (.ColumnWidth / .Width)
  23.                             .ColumnWidth = P.Width * (.ColumnWidth / .Width)    '調整儲存格欄寬=>照片的寬度
  24.                         End If
  25.                     End With
  26.                 End If
  27.             Next
  28.         End With
  29.         For Each P In Sh.Pictures
  30.             P.Width = Sh.Cells(i, "a").Width  '調整所有的照片寬度一致
  31.         Next
  32.         .Quit        '關閉網頁
  33.     End With
  34. End Sub
複製代碼
作者: justinbaba    時間: 2014-10-31 16:26

謝謝 抓D: 的我再移去 那個討論串~~

而我照您說的方式去執行~~ 跳出了一個訊息 "應用程式或物件定義上的錯誤"  是否我有那邊沒執行對嗎？

並且想知道~~ 是否有機會抓 FB 裡頭的照片 ，而且可以貼多張不同的照片到自己指定的欄位..

[attach]19435[/attach]

不好意思~~ 問題很多，請多包含 @@
作者: justinbaba    時間: 2014-10-31 19:57

謝謝 抓D: 的我再移去 那個討論串~~

而我照您說的方式去執行~~ 跳出了一個訊息 "應用程式或物件定義上的 ...
justinbaba 發表於 2014-10-31 16:26


[attach]19439[/attach]
檔案已上傳，謝謝..



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)