UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Images to Excel, Embeded bitmaps exported to excel    
 
   
NewToAccess2019
post Mar 21 2019, 10:13 AM
Post#1



Posts: 32
Joined: 21-March 19



Hello Experts,

Can you please help me with this. I have the same query, but in my DB I am storing the pictures as BITMAP IMAGES for corresponding records. (So in my case it isn't an attachment, more so an actual image record).
Space is not an issue for my DB. I need the records with the IMAGE in the excel, that is the end result.
This post has been edited by NewToAccess2019: Mar 21 2019, 10:14 AM
Go to the top of the page
 
GroverParkGeorge
post Mar 21 2019, 10:47 AM
Post#2


UA Admin
Posts: 36,041
Joined: 20-June 02
From: Newcastle, WA


Welcome to UtterAccess.

I created a separate topic for your new question because attaching new questions to much older threads tends to bury them, meaning fewer people might see and answer.

What exactly do you need help with here?

--------------------
My Real Name Is George. Grover Park Consulting is where I do business.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
NewToAccess2019
post Aug 29 2019, 10:06 AM
Post#3



Posts: 32
Joined: 21-March 19



I have a folder called Images, it has .jpg files.


CODE
Option Explicit

Sub Insert()

    Dim strFolder As String
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngCell As Range

    strFolder = "C:\Users\Domenic\Pictures\Saved Pictures\" 'change the path accordingly
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If

    Set rngCell = Range("E1") 'starting cell

    strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .jpg files

    Do While Len(strFileName) > 0
        Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Left
            .Top = rngCell.Top
            .Height = rngCell.RowHeight
            .Placement = xlMoveAndSize
        End With
        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop

End Sub


The code is able to fetch data I need (imagefiles), but it is pasting the images in one column -- Range ("E1").

I need to write an "if" condition to match the imagenames in the excel and paste image when a match is found.
This post has been edited by NewToAccess2019: Aug 29 2019, 10:32 AM
Attached File(s)
Attached File  excel.png ( 8.86K )Number of downloads: 3
Attached File  images.png ( 46.89K )Number of downloads: 3
 
Go to the top of the page
 
arnelgp
post Aug 29 2019, 10:08 PM
Post#4



Posts: 1,510
Joined: 2-April 09
From: somewhere out there...


CODE
   Do While Len(strFileName) > 0
        rngCell = Cells.Find strFileName
        If Not (fndRng Is Nothing) Then
           Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
           With objPic
               .Left = rngCell.Left
               .Top = rngCell.Top
               .Height = rngCell.RowHeight
               .Placement = xlMoveAndSize
           End With
        End If
        strFileName = Dir
    Loop

This post has been edited by arnelgp: Aug 29 2019, 10:23 PM

--------------------
Never stop learning, because life never stops teaching.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    15th November 2019 - 06:50 PM