PDA

View Full Version : Store image in VBA?



MarylandDIY
04-12-2016, 12:09 PM
Hello everyone!

Is there a way to store an image in a VBA project so that I or other people on other machines can use a macro that inserts that image into a report? I suspect not since I cannot find anything that suggests we can and the only threads I do find are about inserting images from file; but I would like to confirm before moving forward.

I am very new to VBA and have generated a couple of macros for developing simple reports for my team to use. I am now working on developing a macro which, among other things, pastes our logo on the first page of a Word document (and then writes some canned language which pulls numbers from the Excel data and pastes some tables and charts). Since I'll be forwarding the macro to my teammates, I don't want them to have to save the image to a folder as well. I was thinking maybe I can paste the image in the workbook I email to them and write a macro in that workbook that writes the report generating macro to their personal workbook and pastes the image in the emailed workbook to their personal workbook. Is that possible?

Thanks in advance for any help you can offer.

All the best,

MarylandDIY

Paul_Hossler
04-12-2016, 06:03 PM
For the Excel part, you can put the images on a hidden (or very hidden) worksheet and use a macro to paste them (at least to another worksheet

Here's a very simple example

Leith Ross
04-12-2016, 06:22 PM
Hello MarylandDIY,

These two macros may help you. I wrote these several years ago so file data could be kept in the workbook and the file restored when needed on the user's system.

Any file can be stored this way because it is copied as a byte array to the worksheet. The bytes are in hexadecimal. This makes it easier to locate problems in a file.

Add a new VBA module to your workbook for these macros.



Private Sub SaveAsHexFile(ByVal Filename As String)

Dim c As Long
Dim DataByte As Byte
Dim Data() As Variant
Dim i As Long
Dim n As Integer
Dim r As Long
Dim Wks As Worksheet
Dim x As String


If Dir(Filename) = "" Then
MsgBox "The File '" & Filename & "' Not Found."
Exit Sub
End If

On Error Resume Next
Set Wks = Worksheets("Hex Byte Data")
If Err = 9 Then
Worksheets.Add After:=Worksheets.Count
Set Wks = ActiveSheet
Wks.Name = "Hex Byte Data"
End If
On Error GoTo 0

Wks.Cells.ClearContents
Wks.Cells(1, "AH").Value = Dir(Filename)

n = FreeFile

Application.ScreenUpdating = False
Application.ErrorCheckingOptions.NumberAsText = False

With Wks.Columns("A:AF")
.NumberFormat = "@"
.Cells.HorizontalAlignment = xlCenter

Open Filename For Binary Access Read As #n
ReDim Data((LOF(n) - 1) \ 32, 31)

For i = 0 To LOF(n) - 1
Get #n, , DataByte
c = i Mod 32
r = i \ 32
x = Hex(DataByte)
If DataByte < 16 Then x = "0" & x
Data(r, c) = x
Next i
Close #n

Wks.Range("A1:AF1").Resize(r + 1, 32).Value = Data
.Columns("A:AF").AutoFit
End With

Application.ScreenUpdating = True

End Sub

Function RestoreHexFile() As String

Dim Cell As Range
Dim Data() As Byte
Dim File As String
Dim j As Long
Dim LSB As Variant
Dim MSB As Variant
Dim n As Integer
Dim Rng As Range
Dim Wks As Worksheet

On Error Resume Next
Set Wks = Worksheets("Hex Byte Data")
If Err <> 0 Then
MsgBox "The Worksheet 'Hex Byte Data' is Missing.", vbCritical
Exit Function
End If
On Error GoTo 0

Set Rng = Wks.Range("A1").CurrentRegion

File = Wks.Cells(1, "AH").Value

If File <> "" Then
n = FreeFile
File = Environ("TEMP") & "\" & File

Open File For Binary Access Write As #n
ReDim Data(Application.CountA(Rng) - 1)

For Each Cell In Rng
If Cell = "" Then Exit For

MSB = Left(Cell, 1)
If IsNumeric(MSB) Then MSB = 16 * MSB Else MSB = 16 * (Asc(MSB) - 55)

LSB = Right(Cell, 1)
If Not IsNumeric(LSB) Then LSB = (Asc(LSB) - 55) Else LSB = LSB * 1

Data(j) = MSB + LSB
j = j + 1
Next Cell

Put #n, , Data
Close #n
End If

RestoreHexFile = File

End Function


Example


Sub Test()

Dim Filename As String

' Save picture to the worksheet Hex Byte Data.
Filename = "C:\Test\V447114.jpg"
Call SaveAsHexFile(Filename)

' Restore the file to the user's Temp directory.
Filename = RestoreHexFile

' Filename now is the complete file path to the restored file.
' Pass this to another macro or application.

End Sub

snb
04-13-2016, 01:20 AM
I'd make a template in Word, the logo included, and send that to your colleagues.

MarylandDIY
04-13-2016, 06:19 AM
Great! Thanks Paul, Leith and snb! Leith, your macros lookvery interesting. Before I wrote my original post, I was wondering if I couldstore an image in an array. Fantastic! I can’t wait to try them out. And snb, yoursis a very simple solution which I hadn’t considered. Thanks everyone!

erwi
07-04-2017, 03:37 AM
---> Leith Ross

Wow, those macros worked perfectly!

I have implemented them in a PERSONAL.XLSB with some common macros I distribute to my colleagues. Some of the macros insert our company logo in the header of the document. Up until now, this logo has been placed on our network drive so it could be reached by everybody, but as there's a file retention policy it is archived every few months, why the macro crashes and the logo needs to be uploaded to the network drive again.

Now, with your macro implemented, I have created a worksheet containing the hex code for the image directly in the PERSONAL.XLSB file, and the image is just restored from there whenever it's needed.

So. Awesome. I registered on this site to give you this thumbs up - thank you!!

Leith Ross
07-04-2017, 10:35 AM
Hello erwi,

It is great to hear that the macros have worked really well for you. More amazing is this code was posted almost 5 years ago and you found it.

Glad I could help solve your problem. Thanks again for sharing your story.

erwi
07-04-2017, 01:41 PM
It's only 8 months old, no? Maybe you looked at your own registration date. I wouldn't resuscitate a five year old thread without contributing constructively. ;)
Thanks to Google as well, understanding where to direct me after my vague search terms. :)

s.keyhanian
02-22-2019, 03:50 PM
This code was really helpful for me. Thanks a lot

Leith Ross
02-25-2019, 03:27 PM
Hello s.keyhanian,

Niets te danken! Glad I could help.