源英 發問時間: 電腦與網際網路軟體 · 8 年前

excel插入圖片的巨集?

excel 能做到a4的紙張,整面都插入圖片嗎?

有圖片檔7000張,放在d:\圖片\0001.jpg ........7000.jpg

每張圖片的高度是2.54公分,寬度是2.2公分。

設定圖片格式\摘要資訊\大小固定,位置隨儲存格而變(M)

列印物件打鉤。

比例

高100%

寬100%

鎖定長寬比

相對於原始圖片大小。

excel的列高是79.5(106像素)

欄寬 11.3(94像素)

照片剛好放入儲存格。

圖片插入儲存格的條件設定

excel的第一列預備插入圖片

excel的第二列用程式來編號,由0001到7000。

每列只編7個號碼。就是

a2=0001,

b2=0002,

c2=0003,

d2=0004,

e2=0005,

f2=0006,

g2=0007。

第四列是編號

a4=0008,

b4=0009,

c4=0010,

d4=0011,

e4=0012,

F4=0013,

g4=0014。

第六列以此類推:一直到一面編號到0050。

也就是a4的整面,只能有50個圖片。

0051就到另一張a4。

有了上面的編號後,用程式來找,當找到編號

a2=0001時,就把d:\圖片\的0001.jpg插在a1的儲存格中,找到

b2=0002時,就把0002.jpg的圖片,插在b1的儲存格中,以下類推,

一直到7000才停止。

這個程式或巨集,如何寫?有公式或函數可套嗎?

謝謝!

3 個解答

評分
  • 8 年前
    最佳解答

    <範例檔>先測看看:

    http://www.funp.net/844818

    2012-09-07 22:00:12 補充:

    EXCEL VBA.以工作表〔A4〕列印版面一次載入〔50張圖片〕

                             <.准提部林.>

    ---------------------------------

    ■程式碼:

     <頂端宣告>

     Dim xRng As Range, ShpRng As Range, TmpPath$

     

     

     Sub 載入全部圖片()

     Dim x&, y&

     TmpPath = "D:\圖片"

     If Dir(TmpPath, vbDirectory) = "" Then

      MsgBox "※找不到圖片資料夾〔" & TmpPath & "〕!": Exit Sub

     End If

     ActiveSheet.Pictures.Delete

     Application.ScreenUpdating = False

     For x = 2 To 16 Step 2

     For y = 1 To 7

       Set xRng = Cells(x, y)

       If xRng <> "" Then Set ShpRng = xRng(0, 1): Call 插入圖片

     Next y: Next x

     End Sub

     

     

     Sub 插入圖片()

     Dim TestObj, TestFolder, xFolder, xImgFile$

     '↓先搜尋第1層資料夾  

     xImgFile = TmpPath & "\" & xRng & ".JPG"

     If Dir(xImgFile) <> "" Then GoTo INSERT_IMG

     '↓找不到時,再搜尋下一層子資料夾  

     Set TestObj = CreateObject("Scripting.FileSystemObject")

     Set TestFolder = TestObj.GetFolder(TmpPath).SubFolders

     If TestFolder.Count = 0 Then Exit Sub

     For Each xFolder In TestFolder

       xImgFile = xFolder & "\" & xRng & ".JPG"

       If Dir(xImgFile) <> "" Then GoTo INSERT_IMG: Exit For

     Next

     Exit Sub

     '↓載入圖檔及設定  

     INSERT_IMG:

     ActiveSheet.Pictures.Insert (xImgFile)

     With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

       .ControlFormat.PrintObject = True

       .LockAspectRatio = msoTrue

       If .Width > ShpRng.Width - 1 Then .Width = ShpRng.Width - 1

       If .Height > ShpRng.Height - 1 Then .Height = ShpRng.Height - 1

       .Left = ShpRng.Left + (ShpRng.Width - .Width) / 2

       .Top = ShpRng.Top + (ShpRng.Width - .Width) / 2

     End With

     End Sub

     

    ■說明:

     若要讓圖片載入時不改變其尺寸(維持 100%),則:

     1.圖片原檔規格:94x106像素。

     2.圖片儲存格:高80.25.寬11.38。

     3.儲存格外緣有細框,圖片與編號中間則無框線。

    ---------------------------------

    <範例檔>加入框線及圖片置中,請重新下載:

    http://www.funp.net/665802

    ---------------------------------

    2012-09-10 12:59:18 補充:

    .Top = ShpRng.Top + (ShpRng.Width - .Width) / 2

    請更正為:

    .Top = ShpRng.Top + (ShpRng.Height - .Height) / 2

  • 6 年前

    我本來從沒遇到過修NAS修硬碟和隨身碟要資料救援,一開始也跟大家一樣總是問價格到處比價,因為不懂,凡事都從價格,考量,輕言聽信朋友介紹比較便宜一家,找錯家之後痛苦尾隨而來,以下省略500字........,後來自己上網找資料救援找到硬碟醫院,和他們經理溝通之後給我正確觀念,這是妳寶貴的資料,妳要考慮是救不救的回問題,而不是貴不貴問題,如果重要請找對人搶救NAS資料硬碟救援才能恢復你的NAS中多顆的硬碟資料

    http://www.datamaster.com.tw/

  • 8 年前

    准提部林:您好!

    我以為excel 已經到了極限,恐怕再也沒人弄得出來了吧,同時我想大概也沒人會看得懂我寫的意思,想不到您不但看懂了,而且很精準的,把答案給作出來了,一次就ok了,真是了不起,太神了,太棒了,好像難不倒您耶!不過也大概只有我,會有這麼怪異的想法吧!

    太好了,可以用了,不過如果能將插入的照片,能放在格子的中央,那會是更完美了,(因為儲存格及每張照片我都有固定的尺寸),您的好像是靠上和靠左。

    再來如果編號與對應的照片,用外框把它框起來,編號與照片中間的那條橫線不顯示,會比較好看些。

    最後,還是請您把此答案移到「所有回答」好嗎?

    謝謝!

還有問題?馬上發問,尋求解答。