Board logo

標題: 置入圖片 [打印本頁]
作者: Jared    時間: 2014-7-10 16:35     標題: 置入圖片

想請問大大
目前我在研究一個功能

如果資料夾裡面有N張圖片
我的Test頁籤畫面只有9格欄位
按下按鈕後程式會將相對應的圖片匯入(祥見圖片)
[attach]18672[/attach]
但是如果超過9格欄位
能不能自動複製相同的頁籤
再把剩下沒有放進去的圖片置入
我目前有手動嘗試過複製頁籤
但是Image命名不會變成 Image10~Image18
要怎麼樣才能解決目前的瓶頸><
希望能有神人指引我方向...
  1. Private Sub CommandButton1_Click()
  2. '----讀入圖片

  4.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\1.jpg") <> "" Then
  5.     Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\1.jpg")
  6.     Else
  7.     Image1.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  8.     End If
  9.    
  10.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\2.jpg") <> "" Then
  11.     Image2.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\2.jpg")
  12.     Else
  13.     Image2.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  14.     End If
  15.    
  16.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\3.jpg") <> "" Then
  17.     Image3.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\3.jpg")
  18.     Else
  19.     Image3.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  20.     End If
  21.    
  22.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\4.jpg") <> "" Then
  23.     Image4.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\4.jpg")
  24.     Else
  25.     Image4.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  26.     End If
  27.    
  28.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\5.jpg") <> "" Then
  29.     Image5.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\5.jpg")
  30.     Else
  31.     Image5.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  32.     End If
  33.    
  34.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\6.jpg") <> "" Then
  35.     Image6.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\6.jpg")
  36.     Else
  37.     Image6.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  38.     End If
  39.    
  40.      If Dir(ThisWorkbook.Path & "\" & "Test" & "\7.jpg") <> "" Then
  41.     Image7.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\7.jpg")
  42.     Else
  43.     Image7.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  44.     End If
  45.    
  46.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\8.jpg") <> "" Then
  47.     Image8.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\8.jpg")
  48.     Else
  49.     Image8.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  50.     End If
  51.    
  52.     If Dir(ThisWorkbook.Path & "\" & "Test" & "\9.jpg") <> "" Then
  53.     Image9.Picture = LoadPicture(ThisWorkbook.Path & "\" & "Test" & "\9.jpg")
  54.     Else
  55.     Image9.Picture = LoadPicture(ThisWorkbook.Path & "\white.jpg")
  56.     End If
  57.    

  59.     End Sub
複製代碼
作者: GBKEE    時間: 2014-7-12 14:21

回復 1# Jared
附檔 看看
作者: Jared    時間: 2014-7-14 15:09

回復 2# GBKEE

附檔如下，內有10張圖片
希望能計算超過原本頁籤內的框架圖片
能另外新增相同架構的頁面置入剩下圖片

麻煩你了∼><
[attach]18694[/attach]
作者: GBKEE    時間: 2014-7-15 18:24

本帖最後由 GBKEE 於 2014-7-15 18:29 編輯

回復 3# Jared

試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Integer, R As Integer, C As Integer
  4.     Dim S As String
  5.     R = 10  '第10個 Image  列的位置
  6.     C = 1   '第10個 Image  欗的位置
  7.     With ActiveSheet
  8.         i = 10
  9.         On Error Resume Next
  10.         Do
  11.             .OLEObjects("Image" & i).Delete
  12.             i = i + 1
  13.         Loop Until Err <> 0
  14.         Err.Clear
  15.         On Error GoTo 0
  16.         S = Dir(ThisWorkbook.Path & "\Test\*.gif")
  17.         i = 0
  18.         Do While S <> ""
  19.             i = i + 1
  20.             If i <= 9 Then
  21.                 .OLEObjects("Image" & i).Object.Picture = LoadPicture(ThisWorkbook.Path & "\Test\" & S)
  22.             Else
  23.              With .OLEObjects.Add(ClassType:="Forms.Image.1", Left:=.Cells(R, C).Left, Top:=.Cells(R, C).Top, Width:=.Cells(R, C).Resize(, 2).Width, Height:=.Cells(R, C).Resize(3).Height)
  24.                 .Name = "Image" & i
  25.                 .Object.Picture = LoadPicture(ThisWorkbook.Path & "\Test\" & S)
  26.                 R = R
  27.                 C = C + 2 'Image 有3欄(欄寬=2)
  28.                 If C > 6 Then
  29.                     C = 1
  30.                     R = R + 3  'Image 有3列(列高=3列)
  31.                 End If
  32.              End With
  33.             End If
  34.             S = Dir
  35.         Loop
  36.         i = i + 1
  37.         On Error Resume Next
  38.         Do
  39.             If i <= 9 Then
  40.                 .OLEObjects("Image" & i).Object.Picture = LoadPicture("")
  41.             End If
  42.             i = i + 1
  43.         Loop Until Err <> 0
  44.     End With
  45. End Sub
複製代碼
作者: Jared    時間: 2014-7-16 10:19

回復 4# GBKEE


感謝大大的協助
只是跟我想完成的有點不太一樣

昨天有寫了大致上的方向，可以執行
只是我程式在執行的時候
沒有採用判斷和迴圈的方式
以致於程式碼一堆...
最後沒辦法在第二頁更新圖片(如附檔)
[attach]18705[/attach]



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