Count # of pixels in BMP file

seraslibre

New Member
Joined
Sep 1, 2009
Messages
9
I'm trying to analyze a BMP image to determine area information based on pixel color:

e.g.: Count the number of pixels within the following range:
1. 51% grey to black
2. white to 50% grey

Could I do this with VBA? I am assuming it is better to work with a BMP file, but is it better to work with an alternate format?

Thanks in advance!
 
Last edited:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi

This can definitely be done, because I have worked with something very similar before. Are you working with 24 bit bmp files?

To find out, copy this code into a spreadsheet macro, run the 'Main' sub-routine, you will be prompted for a bmp file and post back with the bitsize. It's much easier if it's 24.

Andrew

Code:
Option Explicit

Private Type PTbmpFileHeader
    bmpType As String * 2
    bmpSize As Long
    bmpRes1 As Integer
    bmpRes2 As Integer
    bmpOffBits As Long
End Type

Private Type PTbmpTypeInfoHeader
    bmpSize As Long
    bmpWidth As Long
    bmpHeight As Long
    bmpPlanes As Integer
    bmpBits As Integer
    bmpCompression As Long
    bmpImageSize As Long
    bmpxRes As Long
    bmpyRes As Long
    bmpColours As Long
    bmpImptColors As Long
End Type

Dim MyFile As String
        
Sub Main()

Dim flNum As Integer
Dim bmpFileHeader As PTbmpFileHeader
Dim bmpInfoHeader As PTbmpTypeInfoHeader

If GetFile = False Then Exit Sub

flNum = FreeFile()

    Open MyFile For Binary Access Read As flNum

    Get flNum, 1, bmpFileHeader
    
    Get flNum, , bmpInfoHeader
    
    MsgBox "Bitsize = " & bmpInfoHeader.bmpBits
    
Close flNum

End Sub


Function GetFile() As Boolean

Dim fd As FileDialog, vrtSelectedItem As Variant

GetFile = False
 
Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
With fd
    .AllowMultiSelect = False
    .Title = "Please select the bitmpap file."
    .Filters.Add "Bitmap files", "*.bmp", 1
 
    If .Show = -1 Then
        MyFile = .SelectedItems(1)
        GetFile = True
    End If
End With

End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,129,752
Messages
5,638,162
Members
417,011
Latest member
Amaden95

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top