Board logo

標題: [發問] 自動插入圖片 [打印本頁]

作者: 建銘    時間: 2016-5-22 09:56     標題: 自動插入圖片

大家好
因為有需求,在看了這邊文章,發現圖片檔案可以自動帶入
http://forum.twbts.com/thread-11280-1-1.html

想詢問如何在欄位輸入名稱後,自動插入圖片
圖片存放的位置 D:\JPG

輸入檔案名稱的欄位有2欄

輸入檔案名稱 B6, B14 ...B14+8 (間隔8個欄位)
顯示圖片位置 A5, A13 ...A13+8 (間隔8個欄位)
圖片跨欄A5~A12顯示

輸入檔案名稱 E6, E14 ...E14+8 (間隔8個欄位)
顯示圖片位置 D5,D13 ...D13+8 (間隔8個欄位)
圖片跨欄D5~D12顯示

若找不到檔案,會顯示找不到檔案

應該如何做編輯?

謝謝大家幫忙
作者: ML089    時間: 2016-5-23 14:41

參考 GBKEE 大
http://forum.twbts.com/thread-11280-1-1.html


Option Explicit
Sub JpgInsert()
    Dim Mypath As String, E As Range, x%, y%   ', MyPic As Object
    Mypath = "D:\JPG\"
    Application.ScreenUpdating = False

    With Sheets("Sheet1")
        .Pictures.Delete '刪除全部圖片
        For y = 0 To 9
            For x = 0 To 2
                Set E = Cells(5 + 8 * y, 1 + x * 3)
'                E.Resize(8).ColumnWidth = 30     '調整儲存格寬度
'                E.Resize(8).RowHeight = 20        '調整儲存格高度
                If Dir(Mypath & E(2, 2) & ".jpg") <> "" Then
                    'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
                    With .Pictures.Insert(Mypath & E(2, 2) & ".jpg")
                        .ShapeRange.LockAspectRatio = msoFalse '圖形比例 msoTrue / msoFalse=填滿格
                        .Left = E.Resize(8).Left
                        .Top = E.Resize(8).Top
                        .Width = E.Resize(8).Width   '=儲存格寬度
                        .Height = E.Resize(8).Height '=儲存格高度
                    End With
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

作者: 建銘    時間: 2016-5-26 01:56

本帖最後由 建銘 於 2016-5-26 01:57 編輯

回復 2# ML089

ML089 您好

報歉,現在才回覆訊息。

想詢問程式要貼在那裡,以及如何執行:
試了貼在工作表sheet1(sheet1),
檔案路徑和檔案型態都確認了,
圖案無法顯示,再請幫忙指點ㄧˊ下,
要將程式貼在那裡,及如何執行。

謝謝您。
作者: c_c_lai    時間: 2016-5-26 09:04

本帖最後由 c_c_lai 於 2016-5-26 09:10 編輯

回復 3# 建銘
將程式貼至 ThisWorkbook 或是 你的工作表單內 (譬如:"Sheet1" 、"工作表1") 或是模組內 (如:Module1、模組1) 均可。
順手將
  1.     With .Pictures.Insert(Mypath & E(2, 2) & ".jpg")
複製代碼
修改成
  1.     ActiveSheet.Pictures.Insert(Mypath & E(2, 2) & ".jpg").Select
  2.     With Selection
複製代碼
或是
  1.     .Pictures.Insert(Mypath & E(2, 2) & ".jpg").Select
  2.     With Selection
複製代碼
這是因為你已經位在 With Sheets("xxxxx") 內了,ActiveSheet 即是指 Sheets("xxxxx")。
以及
  1.         For y = 0 To 9
  2.             For x = 0 To 2
複製代碼
修改成
  1.         For y = 0 To 1
  2.             For x = 0 To 1
複製代碼
就符合你的提問了。
作者: ML089    時間: 2016-5-26 16:15

回復 3# 建銘

範例檔案,請下載參考
http://www.FunP.Net/420075

[attach]24356[/attach]
作者: ML089    時間: 2016-5-26 16:17

回復 4# c_c_lai

謝謝指正
作者: c_c_lai    時間: 2016-5-26 18:46

回復 6# ML089
我只是解答 #3 的提問而已,其實你 #5 的範例
也蠻不錯的。尤其是圖片修飾的語法。
作者: 建銘    時間: 2016-5-28 01:32

本帖最後由 建銘 於 2016-5-28 01:33 編輯

各位前輩大家晚上好,

謝謝ML089 與 c_c_lai 兩位的協助,解決了我的問題。

其次,想再繼續詢問,
若將excel檔案存放在電腦桌面,方便直接檔案開啟,
而圖片的部分,檔案存放在D:\JPG,是否可行。

目前現況是excel和jpg檔案需存放在D:\JPG,才能正常顯示圖片。

謝謝。
作者: ML089    時間: 2016-5-28 05:03

回復 8# 建銘


Mypath = ThisWorkbook.Path & "\"    ' "D:\JPG\" '圖片檔案放置目錄

改為
Mypath = "D:\JPG\" '圖片檔案放置目錄
作者: 建銘    時間: 2016-5-29 10:08

本帖最後由 建銘 於 2016-5-29 10:09 編輯

回復 9# ML089


Dear    ML089
謝謝,問題已經解決了。給你一個譖啦!!
作者: 准提部林    時間: 2016-5-31 12:28

本帖最後由 准提部林 於 2016-5-31 12:34 編輯

圖片以儲存格大小縮放, 除非兩者比率相同, 否則無法置中,
而且, 可能圖片遮去儲存格的框線!

另外, Pictures.Insert 在2010版是以連結方法載入圖片, 若路徑中的圖片刪除或移動.更名,
都可能無法顯示圖片, 給個多年前的草作參考:
EXCEL.商品型錄.在〔目錄表〕中快速載入〔商品圖片〕
http://blog.xuite.net/smile1000mile/blog/94861181




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