SOGO論壇
  登入   註冊   找回密碼
查看: 5612|回覆: 0
列印 上一主題 下一主題

如何用EXCEL VBA自動批次匯入圖片與超連結 [複製連結]

Rank: 13Rank: 13Rank: 13Rank: 13

榮譽會員勳章 原創及親傳圖影片高手勳章 熱心參予論壇活動及用心回覆主題勳章 美食達人勳章 成人長片直播分享達人勳章

狀態︰ 離線
跳轉到指定樓層
1
發表於 2017-1-13 13:13:44 |只看該作者 |倒序瀏覽
01快速批次刪除所有的圖檔

02.快速批次將圖檔匯入到指定的儲存格

03.除了圖還有超連結


程式碼:
Sub 縮圖()
    '1.資料夾與副檔名的指定
    sPath = "C:\Users\Administrator\Desktop\APP\"
    sFile = Dir(sPath & "*.png")
    '2.設定寬與高
    Range("A1").Select
    Cells.RowHeight = 100
    Columns("A").ColumnWidth = 18
    '3.迴圈插入所有縮圖
    Do While sFile <> ""
        '插入圖片檔
        ActiveSheet.Shapes.AddPicture sPath & sFile, True, True, 0, iTop, 90, 90
        iTop = iTop + 100
        '搜尋下一個檔案
        sFile = Dir()
        ActiveCell.Offset(1).Select
    Loop
   
    Range("A1").Select
End Sub
Sub 縮圖與超連結()
    '1.資料夾與副檔名的指定
    sPath = "C:\Users\Administrator\Desktop\APP\"
    sFile = Dir(sPath & "*.png")
    '2.設定寬與高
    Range("A1").Select
    Cells.RowHeight = 100
    Columns("A:B").ColumnWidth = 18
    '3.迴圈插入所有縮圖
    Do While sFile <> ""
        '插入圖片檔
        ActiveSheet.Shapes.AddPicture sPath & sFile, True, True, 110, iTop, 90, 90
        iTop = iTop + 100
        '插入超連結
        ActiveCell.WrapText = True
        ActiveCell.Hyperlinks.Add Selection, sPath & sFile
        '輸入sPath
        'ActiveCell.Offset(, -1).Value = sPath
        '搜尋下一個檔案
        sFile = Dir()
        ActiveCell.Offset(1).Select
    Loop
   
    Range("A1").Select
End Sub
Sub 刪除所有圖文()
    Cells.ClearContents
   
    For Each Sh In ActiveSheet.Shapes
        Sh.Delete
    Next
End Sub
喜歡嗎?分享這篇文章給親朋好友︰
                 


本論壇為非營利自由討論平台,所有個人言論不代表本站立場。文章內容如有涉及侵權,請通知管理人員,將立即刪除相關文章資料。侵權申訴或移除要求:abuse@oursogo.com

GMT+8, 2024-11-25 16:26

© 2004-2024 SOGO論壇 OURSOGO.COM
回頂部