- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2012-2-27 20:57 編輯
回復 1# spiritwing - Option Explicit
- Sub Ex()
- Dim xPath As String, xFile As String, Sp As Integer, Cz As Integer, G As Long, K As Integer, Mh As Integer
- Dim ii As Integer
- xPath = "D:\相片\89年\" '圖片的資料夾
- 'Dir 函數 傳回一個 String ，用以表示合乎條件、檔案屬性、磁碟標記的一個檔案名稱、或目錄、檔案夾名稱。
- xFile = Dir(xPath & "*.jpg") '圖片的副檔名 為jpg
- 'xFile = Dir(xPath & "*.*") '圖片的資料夾 都是圖片檔
- With ActiveSheet '作用中的工作表
- Sp = 35 '水平
- Cz = 160 '垂直
- G = 0.1 '高
- K = 170 '寬
- Mh = 4 '每行
- .Pictures.Delete '刪除 所有圖片
- .[a:a] = "" '清除 A欄資料
- ii = 1 '設定為1
- Application.ScreenUpdating = False
- Do
- .Cells(ii, 1).Select '選擇A欄 的第 ii 儲存格(ActiveCell :作用中的儲存格)
- .Cells(ii, 1) = xFile '寫上檔名
- With .Pictures.Insert(xPath & xFile) '插入圖片
- .Left = ActiveCell.Offset(, 2).Left '插入圖片的左端位置是: ActiveCell 右移2欄的左端
- .Top = ActiveCell.Offset(, 2).Top '插入圖片的上端位置是: ActiveCell 右移2欄的上端
- .Width = 190 '設定 插入圖片的 寬度
- .Height = 143 '設定 插入圖片的 高度
- ActiveCell.Offset(, 2).ColumnWidth =33 '設定插入圖片所在儲存格 的寬
- ActiveCell.Offset(, 2).RowHeight = .Height '設定插入圖片所在儲存格 的高
- End With
- xFile = Dir '繼續尋找下一個檔案
- ii = ii + 1 'A欄 的第 ii 儲存格往下一列
- Loop Until xFile = "" '離開 Do 迴圈的條件是: 找不到 檔案
- .[A1].Select
- Selection.EntireColumn.AutoFit 'AutoFit 方法 將範圍中的欄寬和列高調整為最適當的值
- Application.ScreenUpdating = True 'ScreenUpdating 屬性 定如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean
- End With
- End Sub
|
|
發表於 2012-2-27 17:00
| 