SOGO論壇

標題: 如何用EXCEL VBA自動批次匯入圖片與超連結 [列印本頁]

作者: 好吃的蛋塔 時間: 2017-1-13 13:13:44 標題: 如何用EXCEL VBA自動批次匯入圖片與超連結

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

附件: 01.gif (2017-1-13 13:09:28, 705.34 KB) / 下載次數 0
https://oursogo.com/forum.php?mod=attachment&aid=MTI5NTYyNjh8ODhmNTQ4ODd8MTcxNjA5MTAyM3wwfDA%3D

附件: [01快速批次刪除所有的圖檔] 01_快速批次刪除所有的圖檔.png (2017-1-13 13:09:29, 58.79 KB) / 下載次數 0
https://oursogo.com/forum.php?mod=attachment&aid=MTI5NTYyNjl8ODQ3ZTA0Nzl8MTcxNjA5MTAyM3wwfDA%3D

附件: [02.快速批次將圖檔匯入到指定的儲存格] 02_快速批次將圖檔匯入到指定的儲存格.png (2017-1-13 13:09:30, 64.96 KB) / 下載次數 0
https://oursogo.com/forum.php?mod=attachment&aid=MTI5NTYyNzB8Yzg1YTRkYzJ8MTcxNjA5MTAyM3wwfDA%3D

附件: [03.除了圖還有超連結] 03_除了圖還有超連結.png (2017-1-13 13:09:32, 452.49 KB) / 下載次數 0
https://oursogo.com/forum.php?mod=attachment&aid=MTI5NTYyNzF8M2EwOTM5YzJ8MTcxNjA5MTAyM3wwfDA%3D

歡迎光臨 SOGO論壇 (https://oursogo.com/)