玩樂天堂 pockyland

標題: 替Brickset下載的CSV檔零件加上圖片方便採購比對 [打印本頁]

作者: shangwa 時間: 2015-2-12 11:36
標題: 替Brickset下載的CSV檔零件加上圖片方便採購比對
本帖最後由 shangwa 於 2015-2-12 13:04 編輯

潛水很久,應該要來分享一下小小心得,希望這個園地能長命百歲

小弟常常在Brickset下載零件清單CSV檔,但是裡面只有圖片連結位置沒有圖片,如下圖 Brickset_40145_CSV
要找零件或是上網採購常要開啟圖片確認一下很麻煩,如果可以變成下圖一樣就方便多了 40145_XLSM
心想阿不就寫個excel macro把圖片載進來縮放大小跟儲存格一樣就好了.
完成如下.只需要先將csv檔另存為xlsm,在開發選單的visual basic編輯器加上這個副程式,按下F5執行就可以但是要注意欄位順序自行修改位置,不會用就用下面的google drive連結把檔案copy下來用我的格式貼也可以
這個macro是我寫的,無版權歡迎修改,複製,發送及分享! 祝大家買的快樂組的也快樂!

Sub InsertImageFullName()

Dim strPicName As String ' File path of a picture
Dim lRowCounts As Long
Dim i As Integer
Dim rngParts As Range

Application.ScreenUpdating = False

Set rngParts = Range("A1") ' Defining input range

lRowCounts = WorksheetFunction.CountA(ThisWorkbook.Sheets(ActiveSheet.Name).Columns("A"))

For i = 1 To lRowCounts - 1
      strPicName = rngParts.Offset(i, 7).Text ' 7 means column H
      rngParts.Offset(i, 1).Select  'we want to put picture into column B
      Set myPicture = ActiveSheet.Pictures.Insert(strPicName)

      With myPicture 'resize the picture into the same size of cell
         .ShapeRange.LockAspectRatio = msoTrue ' Keep aspect ratio
         .Top = rngParts.Offset(i, 1).Top + 1 'move a liitle bit down
         .Left = rngParts.Offset(i, 1).Left + 1  'move a little bit to right
         .Height = rngParts.Offset(i, 1).Height - 2 'almost full of cell size
      End With
Next i

Set myPicture = Nothing
Application.ScreenUpdating = True

End Sub

也可以下載這個excel檔案40145.xlsm

40145_BrickSet.JPG (167.84 KB, 下載次數: 62)

40145_w_Pic.JPG (148.4 KB, 下載次數: 49)

作者: meowmeowmeow 時間: 2015-2-12 12:58
哈
好久沒看到computer programming

試試看

作者: shangwa 時間: 2015-2-12 20:29

meowmeowmeow 發表於 2015-2-12 14:28
哈
好久沒看到computer programming

OK!OK!
如果有問題跟我說一下!

歡迎光臨玩樂天堂 pockyland (https://pockyland.tw/)