SHARE
TWEET

LoadByPicture

reac Sep 3rd, 2019 100 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub LoadByPicture()
  2.  
  3. Const ROW_FIRST = 2
  4. Const COL_ID = 1
  5. Const COL_LOADED = 2
  6. Const COL_BARCODE = 3
  7.  
  8. Dim pictname As String
  9. Dim pictpath As String
  10. Dim pictext As String
  11.  
  12. Dim pastehere As Range
  13. Dim pasterow As Long
  14. Dim i As Long
  15. Dim lastrow As Long
  16.  
  17. Dim pict As Picture
  18. Dim pictloaded As Boolean
  19.  
  20.     On Error Resume Next
  21.  
  22.     pictpath = "D:\Dev\AGC\barcodes\barcode_"
  23.     pictext = ".png"
  24.    
  25.     lastrow = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
  26.     For i = ROW_FIRST To lastrow
  27.    
  28.         Set pastehere = Cells(i, COL_BARCODE)
  29.         pasterow = pastehere.Row
  30.         Cells(pasterow, COL_BARCODE).Select
  31.         pictname = Cells(i, COL_ID)
  32.        
  33.         '/// Check to see if any of the pictures in the current sheet
  34.        '/// have the same position as the cell in the current row,
  35.        '/// if they do, we already have a barcode loaded.
  36.        pictloaded = False
  37.         For Each pict In ActiveSheet.Pictures
  38.             If pict.TopLeftCell = Cells(i, COL_BARCODE) Then
  39.                 pictloaded = True
  40.                 Exit For
  41.             End If
  42.         Next
  43.        
  44.         If Not pictloaded Then
  45.        
  46.            ActiveSheet.Pictures.Insert(pictpath & pictname & pictext).Select
  47.            With Selection
  48.                .Left = Cells(pasterow, COL_BARCODE).Left
  49.                .Top = Cells(pasterow, COL_BARCODE).Top
  50.                .ShapeRange.LockAspectRatio = msoTrue
  51.                .ShapeRange.Height = 80#
  52.                .ShapeRange.Width = 80#
  53.                .ShapeRange.Rotation = 0#
  54.            End With
  55.            
  56.         End If
  57.        
  58.     Next
  59.  
  60. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top