Image Processing Using Excel VBA

This subroutine can load a RGB 24 bit 16 pixel x 16 pixel raw file as a binary file and convert the color image of the raw file to a gray image.

Sub OpenBinaryFile_ExtractRGB_2DArray()
   
    Dim sFilePath As String
    Dim sSaveFilePath As String
    Dim sFolderPath As String
    Dim sReadFileName As String
    Dim sWritefileNmae As String
   
   
   
    Dim i As Integer
    Dim j As Integer
   
    Dim R_x As Integer
    Dim R_y As Integer
    Dim G_x As Integer
    Dim G_y As Integer
    Dim B_x As Integer
    Dim B_y As Integer
    Dim Gray_x As Integer
    Dim Gray_y As Integer
   
    Dim xsize As Integer
    Dim ysize As Integer
   
    Dim R_image_x0 As Integer
    Dim R_image_y0 As Integer
    Dim G_image_x0 As Integer
    Dim G_image_y0 As Integer
    Dim B_image_x0 As Integer
    Dim B_image_y0 As Integer
    Dim Gray_image_x0 As Integer
    Dim Gray_image_y0 As Integer
   
    Dim R(16, 16) As Byte
    Dim G(16, 16) As Byte
    Dim B(16, 16) As Byte
   
    Dim Gray(16, 16) As Byte
   
    Dim get_value As Byte
   
   
    Dim count As Integer
    Dim check_R As Byte
    Dim check_G As Byte
    Dim check_B As Byte
   
   
   
   
    'set file name
   
    sFolderPath = "C:\MyDashboard\II\"
    sReadFileName = "smile.raw"
    sWritefileName = "smile_gray.raw"
   
    sFilePath = sFolderPath & sReadFileName
    sSaveFilePath = sFolderPath & sWritefileName
   
   
    MsgBox "OPEN:" & sFilePath
    MsgBox "SAVE" & sSaveFilePath
   
   
   
   
    xsize = 16
    ysize = 16
   
    R_image_x0 = 5
    R_image_y0 = 4
   
    G_image_x0 = 5
    G_image_y0 = R_image_y0 + ysize + 3
   
    B_image_x0 = 5
    B_image_y0 = G_image_y0 + ysize + 3
    Gray_image_x0 = 5
    Gray_image_y0 = B_image_y0 + ysize + 3
   
   
      
    'Read binary file
    MsgBox "Read binary file"
   
 
   
   
   
    Cells(R_image_y0 - 1, R_image_x0) = "R image"
    Cells(G_image_y0 - 1, G_image_x0) = "G image"
    Cells(B_image_y0 - 1, B_image_x0) = "B image"
   
   
   
   
   
   
   
    file_rgb = FreeFile
    Open sFilePath For Binary As #file_rgb
    'Open "C:\MyDashboard\II\smile.raw" For Binary As #file_rgb
   
   
   
   
    For j = 0 To ysize - 1
        For i = 0 To xsize - 1
       
            R_x = R_image_x0 + i
            R_y = R_image_y0 + j
            G_x = G_image_x0 + i
            G_y = G_image_y0 + j
            B_x = B_image_x0 + i
            B_y = B_image_y0 + j
           
     
            ' Red
            Get #file_rgb, , get_value
            Cells(R_y, R_x) = Int(get_value)
            R(j, i) = CByte(get_value)
           
            ' Green
            Get #file_rgb, , get_value
            G(j, i) = CByte(get_value)
            Cells(G_y, G_x) = Int(get_value)
           
            Get #file_rgb, , get_value
            B(j, i) = CByte(get_value)
            Cells(B_y, B_x) = Int(get_value)
           
        Next
    Next
   
   
   
    
    Close #file_rgb
   
   
   
   
   
    'Gray image
   
   
    
    file_gray = FreeFile
    Open sSaveFilePath For Binary As #file_gray
    'Open "C:\MyDashboard\II\gray.raw" For Binary As #file_gray
   
   
  
 
   
   
    Cells(Gray_image_y0 - 1, Gray_image_x0) = "Gray image"
   
   
    count = 0
   
    For j = 0 To ysize - 1
        For i = 0 To xsize - 1
       
            R_x = R_image_x0 + i
            R_y = R_image_y0 + j
            G_x = G_image_x0 + i
            G_y = G_image_y0 + j
            B_x = B_image_x0 + i
            B_y = B_image_y0 + j
           
            Gray_x = Gray_image_x0 + i
            Gray_y = Gray_image_y0 + j
           
            Gray(j, i) = CByte(0.3 * R(j, i) + 0.59 * G(j, i) + 0.11 * B(j, i))
            Cells(Gray_y, Gray_x) = Gray(j, i)
            'Cells(Gray_y, Gray_x) = Int(0.3 * Cells(R_y, R_x) + 0.59 * Cells(G_y, G_x) + 0.11 * Cells(B_y, B_x))
           
           
           
          
           
           
           
           
            Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
            Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
            Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
            
        Next
    Next
   
   
    Close #file_gray
   
   
   
    'count the number of your interested color
   
   

   
    check_R = 255
    check_G = 255
    check_B = 255
   
   
    
    
     count = 0
    
     For j = 0 To ysize - 1
         For i = 0 To xsize - 1
        
          If R(j, i) = check_R And G(j, i) = check_G And B(j, i) = check_B Then
             
                 count = count + 1
            
             End If
         Next
     Next

   
   
   
    MsgBox count
   
   
  
  
   
   

   
   
End Sub

Sub ReadRawConvertGray()
   
    Dim i As Integer
    Dim j As Integer
   
    Dim R_x As Integer
    Dim R_y As Integer
    Dim G_x As Integer
    Dim G_y As Integer
    Dim B_x As Integer
    Dim B_y As Integer
    Dim Gray_x As Integer
    Dim Gray_y As Integer
   
    Dim xsize As Integer
    Dim ysize As Integer
   
    Dim R_image_x0 As Integer
    Dim R_image_y0 As Integer
    Dim G_image_x0 As Integer
    Dim G_image_y0 As Integer
    Dim B_image_x0 As Integer
    Dim B_image_y0 As Integer
    Dim Gray_image_x0 As Integer
    Dim Gray_image_y0 As Integer
   
   
    Dim Gray As Integer
   
    Dim get_value As Byte
   
   
   
   
    xsize = 16
    ysize = 16
   
' RGB, Gray output address on the Excel sheet
    R_image_x0 = 5
    R_image_y0 = 4
   
    G_image_x0 = 5
    G_image_y0 = 22
   
    B_image_x0 = 5
    B_image_y0 = 40

    Gray_image_x0 = 23
    Gray_image_y0 = 4
   
   
   
   
      
    'Read binary file
    MsgBox "Read binary file"
   
 
   
   
' Set the label to the range of RGB data   
    Cells(R_image_y0 - 1, R_image_x0) = "R image"
    Cells(G_image_y0 - 1, G_image_x0) = "G image"
    Cells(B_image_y0 - 1, B_image_x0) = "B image"
   
   
   
   
' Open the source file as binary file 
    file_rgb = FreeFile
    Open "smile.raw" For Binary As #file_rgb
   
   
   
   
    For j = 0 To ysize - 1
        For i = 0 To xsize - 1
       
            R_x = R_image_x0 + i
            R_y = R_image_y0 + j
            G_x = G_image_x0 + i
            G_y = G_image_y0 + j
            B_x = B_image_x0 + i
            B_y = B_image_y0 + j
           
' get  one byte data as a Red data from the file   
            Get #file_rgb, , get_value
            Cells(R_y, R_x) = Int(get_value)
           
            Get #file_rgb, , get_value
            Cells(G_y, G_x) = Int(get_value)
           
            Get #file_rgb, , get_value
            Cells(B_y, B_x) = Int(get_value)
           
        Next
    Next
   
   
   
    
    Close #file_rgb
   
   
   
   
   
    'Gray image
   
    file_gray = FreeFile
    Open "gray.raw" For Binary As #file_gray
   
   
   
 ' Set the gray image label on the sheet 
    Cells(Gray_image_y0 - 1, Gray_image_x0) = "Gray image"
   
   
   
    For j = 0 To ysize - 1
        For i = 0 To xsize - 1
       
            R_x = R_image_x0 + i
            R_y = R_image_y0 + j
            G_x = G_image_x0 + i
            G_y = G_image_y0 + j
            B_x = B_image_x0 + i
            B_y = B_image_y0 + j
           
            Gray_x = Gray_image_x0 + i
            Gray_y = Gray_image_y0 + j
  
' calc a gray value from a set of RGB data         
            Cells(Gray_y, Gray_x) = Int(0.3 * Cells(R_y, R_x) + 0.59 * Cells(G_y, G_x) + 0.11 * Cells(B_y, B_x))
           
           
'Save the gray value with byte format into the outputfile using Put command          
             Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
             Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
             Put #file_gray, , CByte(Cells(Gray_y, Gray_x))
            
        Next
    Next
   
   
   
  
    Close #file_gray
   
   


   
   
End Sub