[其他] 替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

評分

參與人數 5	PL金幣 +50	收起 理由
truckmaid	+ 10
Angel後裔	+ 10
闇羽星塵	+ 10	精彩內容，謝謝分享
lyonfish	+ 10	精彩內容，謝謝分享
kuc	+ 10	精彩內容，謝謝分享

查看全部評分