Consulting

Results 1 to 10 of 10

Thread: Store image in VBA?

  1. #1

    Store image in VBA?

    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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    I'd make a template in Word, the logo included, and send that to your colleagues.

  5. #5
    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!

  6. #6
    VBAX Newbie
    Joined
    Jul 2017
    Location
    Copenhagen, Denmark
    Posts
    2
    Location

    Thumbs up

    ---> 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!!

  7. #7
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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.
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  8. #8
    VBAX Newbie
    Joined
    Jul 2017
    Location
    Copenhagen, Denmark
    Posts
    2
    Location
    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.

  9. #9
    This code was really helpful for me. Thanks a lot

  10. #10
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello s.keyhanian,

    Niets te danken! Glad I could help.
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •