返回列表 上一主題 發帖

[發問] 求助.如何在一個300多筆的圖檔案夾內找2張圖>"<

[發問] 求助.如何在一個300多筆的圖檔案夾內找2張圖>"<

小弟最近在學習使用VBA  新手一個請包包含~"~
想用在工作上   
公司報表效用到很多圖  圖片 編碼1-1 , 1-2 ,1-3  ,  2-1 , 2-2  ,2-3  (以此類推300多筆
而且要求用到就要刪掉


想寫個搜索 然後插入圖片 砍掉圖檔
爬文多日也找不到什麼好方法QQ

我也不是想伸手要程式是真的很想學習.
所以跟小弟指點一下大概就好

勞煩各位先進們指點一下.感激:dizzy:

忘了說 1-1 ,1-2 ,1-3  圖檔為一個文件要用
然後裡面常常有間斷的

PS.剛剛忘記打.絕對不適要灌水.大家請原諒我~"~下班還要忙這個只求寫好後部會這麼累了QQ

TOP

有檔案嗎?
這樣描述還是不太懂

TOP

回復 1# naknay


   可以參考我發在這論壇的這一帖:http://forum.twbts.com/thread-21898-1-1.html

TOP

本帖最後由 naknay 於 2019-8-3 01:28 編輯

回復 1# naknay

點我下載
    檔案有點大~勞煩各位先進幫我看一下><||
第一次問問題還問得不好請見諒><

感謝有勞先進了

TOP

本帖最後由 naknay 於 2019-8-3 01:40 編輯
回復  naknay


   可以參考我發在這論壇的這一帖:
jeffrey628litw 發表於 2019-8-2 12:10


感謝前輩提供檔案~小弟再研究看看~先說聲感激~但是功能並不是我需求的不過真的很強大讚嘆中

TOP

1) 看是3張圖???
2) 要學會使用上傳附檔, 方便別人下載

Sub 插人圖片()
Dim i%, P$, N$(3), xR As Range, xS, Shp As Shape
'路徑與資料夾檢測
P = ThisWorkbook.Path & "\客戶名稱圖檔"
If Dir(P, vbDirectory) = "" Then MsgBox "〔客戶名稱圖檔〕路徑錯誤或資料夾不存在!  ": Exit Sub
For Each xR In [A3:C3]
    If xR = "" Then MsgBox xR(0) & "未輸入!  ": Exit Sub
    If xR(0) <> "編號" Then P = P & "\" & xR Else N(0) = xR
    If Dir(P, vbDirectory) = "" Then MsgBox "〔" & xR(0) & "〕路徑錯誤或資料夾不存在!  ": Exit Sub
Next
'圖片檔案檢測
For i = 1 To 3
    N(i) = N(0) & -i & ".jpg"
    If Dir(P & "\" & N(i)) = "" Then MsgBox "找不到〔" & N(i) & "〕圖片檔案!  ": Exit Sub
Next i
'載入圖檔並調整大小及位置
xS = Array("A11", "E11", "I11")
For i = 1 To 3
    Set xR = Range(xS(i - 1)).Resize(9, 4) '圖片放置的範圍
    Set Shp = ActiveSheet.Shapes.AddPicture(P & "\" & N(i), 0, 1, xR.Left, xR.Top, -1, -1)
    If Shp.Height > xR.Height Then Shp.Height = xR.Height - 2 '調整圖片高度
    If Shp.Width > xR.Width Then Shp.Width = xR.Width - 2 '調整圖片寬度
    Shp.Top = xR.Top + (xR.Height - Shp.Height) / 2 '調整圖片上邊界(上下置中)
    Shp.Left = xR.Left + (xR.Width - Shp.Width) / 2 '調整圖片左邊界(左右置中)
    'Kill P & "\" & N(i)  '刪除圖片檔案
Next i
End Sub

TEST_v1.rar (1.63 MB)


========================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 7# 准提部林


非常感謝准提部林前輩幫我修改程式一看簡潔有力~小弟會在學習上傳這部分.
額外請教 編號這邊其實有1-300多筆 是否能做到不填編號去抓.
因為公司要求用過的圖檔不能再使用.

目前想法 N$(300) 這陣列裡面有值的抓出一個值來製作.

   或者用循環的判斷方式 (1不在抓2 ,2不在抓3  循環下去 )300多筆程式因該不會跑很久.

  所以請教
    N(i) = N(0) & -i & ".jpg"
    If Dir(P & "\" & N(i)) = "" Then MsgBox "找不到〔" & N(i) & "〕圖片檔案!  ": Exit Sub

所以再次請益 前輩們這段如何修改.感激不盡

TOP

回復 8# naknay


規則不明, 能否說清楚詳細???
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 9# 准提部林
感謝大大回復


目標檔案夾內的編號1-300的照片並不會一直存在

而文件只要隨意使用一組照片即可.而使用過的照片必須刪除.編號既不存在

抱歉表達的不適很好.深感抱歉

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題