返回列表 上一主題 發帖

置入圖片

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-7-10 16:35 | 只看該作者

置入圖片

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

如果資料夾裡面有N張圖片
我的Test頁籤畫面只有9格欄位
按下按鈕後程式會將相對應的圖片匯入(祥見圖片)

但是如果超過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
複製代碼
收藏 分享
Jared

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
5#
發表於 2014-7-16 10:19 | 只看該作者
回復 4# GBKEE


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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
3#
發表於 2014-7-14 15:09 | 只看該作者
回復 2# GBKEE

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

麻煩你了∼><
測試VBA.zip (169.77 KB)
Jared

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-7-12 14:21 | 只看該作者
回復 1# Jared
附檔 看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題