替Brickset下載的CSV檔零件加上圖片方便採購比對

shangwa

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


小弟常常在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

meowmeowmeow

哈
好久沒看到computer programming

試試看

shangwa

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

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