返回列表 上一主題 發帖

[發問] 判斷資料夾內是否有檔案

a703130

帖子
97 
主題
32 
精華
0 
積分
167 
點名
0  
作業系統
WinXP 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-3-22 
最後登錄
2017-8-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-12-5 10:30 | 只看該作者

[發問] 判斷資料夾內是否有檔案

本帖最後由 a703130 於 2012-12-5 10:32 編輯

下面是我的一部份程式碼,目標是從a.xls抓檔案名稱,再去資料夾內抓取圖檔,修改大小後放回a.xls檔
目前遇到一個問題,就是當我a.xls抓了檔案名稱,但是資料夾內沒有檔案,我該如何判斷

是否在第15行前加入一判斷式,判斷檔案名稱是否存在於資料夾,如果沒有則離開if 判斷式
判斷檔案是否存在,這部分我不知道如何寫~是否能請前輩幫忙,感激不盡
  1. Sub InsertImage(ImagePath, FolderName)
  2.     Dim ReadRow As Integer
  3.     Dim ImageName As String
  4.     Sheets("a").Select
  5.     ReadRow = 24
  6.    
  7. '判斷Safety頁面第一欄是否有需要載入圖檔直至出現"END"字樣
  8.     Do Until UCase(Cells(ReadRow, 1)) = "END"
  9.         ImageName = Cells(ReadRow, 1)
  10.         
  11. '利用CheckFileName func 來判斷是否有關鍵字 ".PNG & .JPG"，如果有則載入圖片
  12.         If CheckFileName(UCase(ImageName)) = True Then
  13.             Cells(ReadRow, 2).Select
  14.             ActiveSheet.Pictures.Insert(ImagePath & "\" & FolderName & "\" & ImageName).Select
  15.             Call ImageSize
  16.         Else
  17.         End If
  18.         ReadRow = ReadRow + 1
  19.     Loop
  20. End Sub

  22. Function CheckFileName(ByVal ImageName As Variant) As Boolean
  23.     Dim ImageLenth As Integer
  24.     Select Case ImageName
  25. '如果空白則離開此 func
  26.     Case Is = ""
  27.         CheckFileName = False
  28.         Exit Function
  29. '計算字串長度並擷取後面4個字元，判斷是否有關鍵字 ".PNG & .JPG"，如果有則載入圖片
  30.     Case Else
  31.         ImageLenth = Len(ImageName)
  32.         ImageName = Mid(ImageName, ImageLenth - 4 + 1, 4)
  33.         If ImageName = ".PNG" Or ImageName = ".JPG" Then
  34.             CheckFileName = True
  35.         Else
  36.             CheckFileName = False
  37.         End If
  38.     End Select
  39. End Function

  41. '設定圖檔的Size大小及位置
  42. Sub ImageSize()
  43.     Selection.ShapeRange.LockAspectRatio = msoFalse
  44.     Selection.ShapeRange.Height = 289.5
  45.     Selection.ShapeRange.Width = 531.75
  46.     Selection.ShapeRange.Rotation = 0#
  47.     Selection.ShapeRange.IncrementLeft 5#
  48.     Selection.ShapeRange.IncrementTop 5#
  49. End Sub
複製代碼
收藏 分享

a703130

帖子
97 
主題
32 
精華
0 
積分
167 
點名
0  
作業系統
WinXP 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-3-22 
最後登錄
2017-8-16 
2#
發表於 2012-12-5 10:33 | 只看該作者
已經不能編輯帖子~應該是14行上面,插圖片之前

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2012-12-5 10:48 | 只看該作者
本帖最後由 GBKEE 於 2012-12-5 11:17 編輯

回復 1# a703130
  1. Option Explicit
  2. Sub Ex() '判斷資料夾內是否有檔案
  3.     'Dir("D:\test\*.PNG") = "" 為資料夾中檔案沒有副檔名是PNG的檔案
  4.     '判斷資料夾中檔案是否有關鍵字 ".PNG & .JPG"
  5.     If Dir("D:\test\*.PNG") = "" And Dir("D:\test\*.JPG") = "" Then MsgBox "資料夾中沒有 .PNG  .JPG"
  6. End Sub
複製代碼
整理一下你的程式碼
  1. Option Explicit
  2. Sub InsertImage(ImagePath, FolderName)
  3.     Dim ReadRow As Integer, ImageName As String
  4.     Sheets("a").Select
  5.     ReadRow = 24
  6.     '判斷Safety頁面第一欄是否有需要載入圖檔直至出現"END"字樣
  7.     Do Until UCase(Cells(ReadRow, 1)) = "END"
  8.         'ImageName = Cells(ReadRow, 1)
  9.         ImageName = ImagePath & "\" & FolderName & "\" & Cells(ReadRow, 1)
  10.         If InStr(ImageName, ".PNG") Or InStr(ImageName, ".JPG") Then
  11.             If Dir(ImageName) <> "" Then
  12.                 Cells(ReadRow, 2).Select
  13.                 ActiveSheet.Pictures.Insert(ImageName).Select
  14.                 Call ImageSize
  15.             End If
  16.         End If
  17.         ReadRow = ReadRow + 1
  18.     Loop
  19. End Sub
複製代碼

TOP

a703130

帖子
97 
主題
32 
精華
0 
積分
167 
點名
0  
作業系統
WinXP 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-3-22 
最後登錄
2017-8-16 
4#
發表於 2012-12-5 15:19 | 只看該作者
謝謝前輩,還勞煩您幫我整理程式碼,因為還不熟悉所以到處都是註解

關於DIR 有進一步認識了

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
返回列表 上一主題