Insert Multiple Bitmap Image into Multiple Worksheet - excel

Question

In my folder, there is AA.bmp, AA.txt, BB.bmp and BB.txt
I am able to extract the data for AA.txt and BB.txt in a separate worksheet.
Am I also able to insert AA.bmp in the same sheet as AA.txt, and BB.bmp in the same sheet as BB.txt?
Sub ExtractData()
iPath = "C:\Users\NHWD78\Desktop\Report\Radiated Immunity\"
ifile = Dir(iPath & "*.txt")
Do While Len(ifile)
Sheets.Add , Sheets(Sheets.Count), , iPath & ifile
ifile = Dir
Range("A10:B10, A16:B19").Copy Destination:=Sheets(Sheets.Count).Range("A1")
Application.CutCopyMode = False
Range("A6:K600").Clear
Columns.AutoFit
Loop
End Sub
I have search throughout the website but only found a way to insert a fixed image with image name.

Answer 1

This will answer your query, its more of a solution than an answer which is not what this site is for, but take the time to read through it as it should be educationally useful too.
You are trying to parse a folder that has content similar to below:-
The result os for these to be in an Excel workbook, with a worksheet containing the text and image for each group (AA, BB, and CC)
First step I would take is to use Microsoft Scripting Runtime, this makes parsing the folder a lot easier. To enable this, within the VBA environment (known as the IDE), select 'Tools' > 'References...', scroll down to 'Microsoft Scripting Runtime' and tick it, then click 'OK' to close the dialog box.
That allows us to the File System Object, which is a very useful file and folder manipulation and interrogation feature set.
Firstly we care most about the *.txt files so lets begin by looping through them:-
Dim FSO As New FileSystemObject
Dim Fldr As Folder
Dim Fl As File
'First we set Fldr to be the folder we care about
Set Fldr = FSO.GetFolder("C:\Users\garye\Desktop\Work")
'Then start a loop to look through each file in the folder
For Each Fl In Fldr.Files
'If the files ends in .txt then we care about it (UCASE used to make it case insensitive)
If Right(UCase(Fl.Name), 4) = ".TXT" Then
'We have found a file
End If
'Do events returns the processor to the system for any other items to be process
'very useful in a loop on a Windows based machine to stop resource hogging and lock ups
DoEvents
Next
Set Fldr = Nothing
Next on the discovery of a text file we want to create a worksheet and import the text. For the sake of this example, it will all be done in a new workbook as well.
Dim WkBk As Workbook
Dim WkBk_Tmp As Workbook
Dim WkSht As Worksheet
Dim WkSht_Tmp As Worksheet
Dim StrName As String
'Create a new workbook
Set WkBk = Application.Workbooks.Add
'...
'Collect the name (i.e. AA from AA.txt)
StrName = Left(Fl.Name, Len(Fl.Name) - 4)
'Create a new worksheet in out new workbook
Set WkSht = WkBk.Worksheets.Add
'Change the worksheet name to the file name
WkSht.Name = StrName
'Open the file in Excel
Set WkBk_Tmp = Application.Workbooks.Open(Fl.Path)
Set WkSht_Tmp = WkBk_Tmp.Worksheets(1)
'Copy its contents into out worksheet
WkSht_Tmp.Cells.Copy WkSht.Cells
Set WkSht_Tmp = Nothing
'Close the file
WkBk_Tmp.Close 0
Set WkBk_Tmp = Nothing
Next we want to insert the image if it is there:-
Dim Rng As Range
'...
'See it a bmp file exists (i.e. AA.bmp)
If FSO.FileExists(Fldr.Path & "\" & StrName & ".bmp") Then
'This get the bottom row of data as a position to insert the image
Set Rng = WkSht.Range(WkSht.Range("A1").End(xlDown).Address).Next(2, 0)
'Add the picture
WkSht.Shapes.AddPicture Fldr.Path & "\" & StrName & ".bmp", msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1
Set Rng = Nothing
End If
If we put all the above together it looks as below, hopefully this has been education in what is happening in the code, some good practices, how to approaching a task.
Option Explicit
Sub ExtractData()
Dim FSO As New FileSystemObject
Dim Fldr As Folder
Dim Fl As File
Dim WkBk As Workbook
Dim WkBk_Tmp As Workbook
Dim WkSht As Worksheet
Dim WkSht_Tmp As Worksheet
Dim StrName As String
Dim Rng As Range
'Create a new workbook
Set WkBk = Application.Workbooks.Add
'First we set Fldr to be the folder we care about
Set Fldr = FSO.GetFolder("C:\Users\garye\Desktop\Work")
'Then start a loop to look through each file in the folder
For Each Fl In Fldr.Files
'If the files ends in .txt then we care about it (UCASE used to make it case insensitive)
If Right(UCase(Fl.Name), 4) = ".TXT" Then
'Collect the name (i.e. AA from AA.txt)
StrName = Left(Fl.Name, Len(Fl.Name) - 4)
'Create a new worksheet in out new workbook
Set WkSht = WkBk.Worksheets.Add
'Change the worksheet name to the file name
WkSht.Name = StrName
'Open the file in Excel
Set WkBk_Tmp = Application.Workbooks.Open(Fl.Path)
Set WkSht_Tmp = WkBk_Tmp.Worksheets(1)
'Copy its contents into out worksheet
WkSht_Tmp.Cells.Copy WkSht.Cells
Set WkSht_Tmp = Nothing
'Close the file
WkBk_Tmp.Close 0
Set WkBk_Tmp = Nothing
'See it a bmp file exists (i.e. AA.bmp)
If FSO.FileExists(Fldr.Path & "\" & StrName & ".bmp") Then
'This get the bottom row of data as a position to insert the image
Set Rng = WkSht.Range(WkSht.Range("A1").End(xlDown).Address).Next(2, 0)
'Add the picture
WkSht.Shapes.AddPicture Fldr.Path & "\" & StrName & ".bmp", msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1
Set Rng = Nothing
End If
Set WkSht = Nothing
End If
'Do events returns the processor to the system for any other items to be process
'very useful in a loop on a Windows based machine to stop resource hogging and lock ups
DoEvents
Next
Set Fldr = Nothing
Set WkBk = Nothing
MsgBox "Done!"
End Sub

Answer 2

Worksheet.Shapes.AddPicture will do it. Example below: -
Public Sub Sample()
Dim WkBk As Workbook
Dim WkSht As Worksheet
Dim Ole As Object
Set WkBk = ThisWorkbook
Set WkSht = WkBk.Worksheets(1)
WkSht.Shapes.AddPicture "C:\Users\garye\Desktop\AA.bmp", msoFalse, msoCTrue, 0, 0, -1, -1
Set WkSht = Nothing
Set WkBk = Nothing
End Sub