Worf

VBA – Transferring picture to worksheet pixel by pixel

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,261
Worf submitted a new Excel article:

VBA – Transferring picture to worksheet pixel by pixel - This code shows how to transfer an image to worksheet cells. Each pixel will correspond to a cell.


Read more about this Excel article...
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sir,
I have a workbook that has 1500 itmes as inventory and items going out and coming in everyday.
I have a userform which i have bult to manage this with ease all items linked to an itemcode. I would like to display the item image as well in the same userform when item is recalled by item code. how can i do this? i there is a method where we can store all images in a folder and all items names with the matching item code but i have no clue how to link them with VBA and display it on the user form.
Can you help on this?
 
Hello Michael

I will analyze your request as soon as possible.
 
the sample code almost drives me to the target. But tPicSize.Height and tPicSize.Width are both -1 for unknown reason.
a temp solution is to make the # of rows and columns for outputs contant. Part of the images can be transferred.

Sub Transfer()
Dim lPixelColor, tPt As POINTAPI, tPicSize As Size, i, j, im, jm
tPt.x = 23
tPt.y = 12
lPixelColor = GetPixelColorFromShape(Sheet2.Shapes("Picture 2"), tPt, tPicSize)
im = tPicSize.Height
jm = tPicSize.Width
Application.ScreenUpdating = False
For i = 1 To 30 ' 30 is originally the "im" varaible. but for unknown reason, it is always -1.
Application.StatusBar = Format(i / im, "0%")
For j = 1 To 30 'jm
tPt.x = j
tPt.y = i
lPixelColor = GetPixelColorFromShape(Sheet2.Shapes("Picture 2"), tPt, tPicSize)
Sheets("map").Cells(i, j).Interior.Color = lPixelColor
Next j, i
Application.ScreenUpdating = True
End Sub


Please advise.

BTW, in windows 10 64 bits version there are several modifications:
"olepro32.dll" should be replaced by "oleaut32.dll"
"Private Declare Function" should be replaced by "Private Declare PtrSafe Function"
 
Slim

I was not able to reproduce the problem. Can you provide a link to a workbook containing an image that causes the problem? I would like to test it on my computer.
 

Attachments

  • 2021-12-19 01_40_04-Microsoft Visual Basic for Applications - Book1 - [Sheet3 (Code)].jpg
    2021-12-19 01_40_04-Microsoft Visual Basic for Applications - Book1 - [Sheet3 (Code)].jpg
    119.8 KB · Views: 45

Forum statistics

Threads
1,226,453
Messages
6,191,135
Members
453,642
Latest member
jefals

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
Back
Top