- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 98
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-27
              
|
23#
發表於 2011-2-23 08:21
| 只看該作者
回復 22# jackyliu
thisworkbook模組- Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
- If SaveAsUI = True And Cancel = False Then
- Dim vbc As Object
- With ThisWorkbook.VBProject
- For Each vbc In .VBComponents
- Select Case vbc.Type
- Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm '註
- .VBComponents.Remove .Item(vbc.Name)
- Case Else
- .VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
- .VBComponents(vbc.Name).CodeModule.CountOfLines
- End Select
- Next
- End With
- End If
- End Sub
- Private Sub Workbook_Open()
- Set d = CreateObject("Scripting.Dictionary")
- fd = ThisWorkbook.Path & "\" '圖檔目錄
- fs = Dir(fd & "*.jpg")
- Do Until fs = ""
- If InStr(fs, "-") = 0 Then '只有數值
- d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2
- ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '只有1個分隔符號
- '第2碼為C就是I欄，否則就在J欄
- V = Split(fs, "-")(1)
- If Split(fs, "-")(1) Like "C*" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
- Else
- '第3碼是1就在K欄，2就在L欄，其餘在M欄
- ar = Split(fs, "-")
- p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '第2碼是C就傳回"K"的字元碼，第2碼是T就傳回"L"的字元碼給變數p
- k = Chr(Val(ar(2)) * 2 + p) '字串變數k的值是第3碼+p對應到的字串(就是欄位)
- d(fs) = k & Val(fs) + 2
- End If
- fs = Dir
- Loop
- With Sheets("Sheet1")
- .Pictures.Delete '清除所有圖片
- Application.ScreenUpdating = False
- For Each ky In d.keys
- Set A = .Range(d(ky)) '圖片插入的位置
- With .Pictures.Insert(fd & ky) '插入圖檔
- .ShapeRange.LockAspectRatio = msoFalse '解除長寬比例
- .Top = A.Top
- .Left = A.Left
- .Height = A.Height
- .Width = A.Width
- End With
- Next
- End With
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2011-2-22 23:30
| 
