iLogic, how to get a Thumbnail to an Excel document?

[checkcheck_master]

This should work, but I get errors:
https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/getting-the-part-assembly-thumbnail/...
Type 'stdole.IPictureDisp' is not defined.
'Compatibility' has not been declared. It may be inaccessible due to its protection level.
See screenshot.

Public Function iThumbnail(FilePath As String) As System.Drawing.Image
	If Not System.IO.File.Exists(FilePath) Then Return Nothing
	Dim oImg As System.Drawing.Image = Nothing
	Try
		Dim iApp As New Inventor.ApprenticeServerComponent
		Dim oDoc As Inventor.ApprenticeServerDocument = iApp.Open(FilePath)
		Dim SummaryInfo As Inventor.PropertySet = oDoc.PropertySets.Item("Inventor Summary Information")
		Dim ThumbProp As Inventor.Property = SummaryInfo.Item("Thumbnail")		
		Dim Thumbnail As stdole.IPictureDisp = CType(ThumbProp.Value, stdole.IPictureDisp)
		If Not Thumbnail Is Nothing Then
			oImg = Compatibility.VB6.IPictureDispToImage(Thumbnail)
		End If
		oDoc.Close()
		iApp.Close()
	Catch Ex As Exception
		MsgBox(ex.Message)
	End Try
	Return oImg
End Function

[WCrihfield]

Hi @checkcheck_master.  Just a quick note about the code you posted.  It is trying to use Apprentice, which is used for light weight standalone application type access to Inventor stuff (mostly read-only type stuff), without having to use the Inventor Application itself.  It can not be used within iLogic rules, VBA macros, or Inventor Add-ins, just in standalone applications...at least that is my understanding.  Here are a couple of links about it (Link1, Link2).

Converting those pesky Inventor.IPictureDisp type images to a more useful format, or trying to use them for something else directly, has been a big pain for a lot of people for a long time.  Many wish that they would change this to a different, more user friendly format.  Probably one of the only bits of code I think I ever got to work fairly well for converting them into something else more useful was a VBA macro I used to use to help me create new button images, based on existing ones, with slight changes.  This macro finds a command in Inventor that has a button in the ribbon for it, then extracts the large and small icons for it, which are Inventor.IPictureDisp format, then uses VBA's version of the 'stdole' (not the same .dll used by vb.net) reference to save them out as BMP files.  The reference used by VBA is called "OLE Automation" and the file location is "C:\Windows\System32\stdole2.tlb" file, on my Windows 10 computer.  When that reference is turned on, I then have access to 'StdFunctions.SavePicture()' and 'StdFunctions.LoadPicture()' methods.

I don't think I was ever able to do anything like this within an iLogic rule yet though.  It won't just convert over, because it won't use that type of reference file.  It has to be a .dll file.  And the stdole.dll file that iLogic has access to does not provide these same tools.

Here is the fairly simple VBA macro code:

Sub Get_CMD_Icon_As_BMP()
    Dim oDef As ButtonDefinition
    Set oDef = ThisApplication.CommandManager.ControlDefinitions.Item("PartExtrudeCmd")
    Dim oLargeIcon As IPictureDisp
    Set oLargeIcon = oDef.LargeIcon
    Dim oStandardIcon As IPictureDisp
    Set oStandardIcon = oDef.StandardIcon
    StdFunctions.SavePicture oLargeIcon, "C:\Temp\PartExtrudeCmd_LargeIcon.bmp"
    StdFunctions.SavePicture oStandardIcon, "C:\Temp\PartExtrudeCmd_StandardIcon.bmp"
End Sub

And here is a screen shot image of the References dialog and Object Browser items, and the code, for added clarity.   The References dialog is right under the Tools tab in the VBA Editor.

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.

If you want and have time, I would appreciate your Vote(s) for My IDEAS :bulb: or you can Explore My CONTRIBUTIONS

[Ralf_Krieg]

Hello

It is possible in iLogic too  in a different way, looks a bit stranger. It's an adapt of the PictureDispConverter posted by Brian Ekins in his Blog

AddReference "System.Drawing"
AddReference "stdole"
AddReference "System.Windows.Forms"

Class ThisRule
	Sub main
		Dim oDoc As Document = ThisDoc.Document
		Dim oThumb As stdole.IPictureDisp
		Do
			oThumb = oDoc.Thumbnail
		Loop While oThumb.Handle<0
	
		Dim myPict As New AxHostConverter 
		Dim oImage As System.Drawing.Image=myPict.GetImageFromIPictureDisp(oThumb)
		
		oImage.Save("C:\TEMP\bmptest.bmp",System.Drawing.Imaging.ImageFormat.Bmp)
	End Sub
End Class

Class AxHostConverter
	Inherits System.Windows.Forms.AxHost
	
	Public Sub New()
    	MyBase.New("{63109182-966B-4e3c-A8B2-8BC4A88D221C}")
	End Sub

	Public Function GetImageFromIPictureDisp(ByVal pictureDisp As stdole.IPictureDisp) As System.Drawing.Image
		Return CType(MyBase.GetPictureFromIPicture(pictureDisp), System.Drawing.Image)
	End Function
End Class

[checkcheck_master]

Thanks Krieg.

Can you please inform me how I can add this to an Excel cell?

This is what I tried:

'----------------------------------------------------------------------------------------------------
' Add Picture

Dim oThumb As stdole.IPictureDisp
Do
oThumb = oDoc.Thumbnail
Loop While oThumb.Handle<0

Dim myPict As New AxHostConverter
Dim oImage As System.Drawing.Image=myPict.GetImageFromIPictureDisp(oThumb)

oImage.Save("C:\TEMP\bmptest.bmp",System.Drawing.Imaging.ImageFormat.Bmp)

oCells.Item(j + 2, 1).Value = oImage

[checkcheck_master]

Hi Krieg.
I see that the images are about 8 Mb.
Is that correct?
That's not exactly my intention, the jpg's I make using oDoc.SaveAs(NewImageFileName, True) are no larger than about 400 Kb, which is very handy.

May I ask you the question differently.
How can I get those images, which are already there anyway, in an Excel cell.
I've done some research and tried that, but to no avail.
I manage to get them into the Excel file, but not to the location so that they come in a cell or have the location of a cell.
So they all come together.
I also more or less understood that the images are over it which is fine by the way.

This is what I've tried, thereafter more code to see my complete struggle.

This one looks great but I do not know how to get it working:

https://stackoverflow.com/questions/12936646/how-to-insert-a-picture-into-excel-at-a-specified-cell-...

With ExcelApp.oExcelSheet.Pictures.Insert(fileName)
'							    With .ShapeRange
'							        .LockAspectRatio = msoTrue
'							        .Width = 75
'							        .Height = 100
'							    End With
'							    .Left = ExcelApp.oExcelSheet.Cells(j, 20).Left
'							    .Top = ExcelApp.oExcelSheet.Cells(j, 20).Top
'							    .Placement = 1
'							    .PrintObject = True
'							End With

'----------------------------------------------------------------------------------------------------
																	' Set an Excel file for the Parts
																	'====================================================================================================
																	' Fill an Excel file
																	' Get the Inventor user name From the Inventor Options
																	myName= ThisApplication.GeneralOptions.UserName
																	
																	' Define the file to create/open																	
																	Dim TEST_BoM_All_Parts As String = sProject_PO_Folder & "TEST_BoM_All_Parts.xlsx"
																	myXLS_File = TEST_BoM_All_Parts
																	
																	'MsgBox(TEST_BoM_All_Parts)	
																	
																	'Get the Inventor user name From the Inventor Options
																	myName= ThisApplication.GeneralOptions.UserName
																	
																	' Define Excel Application object
																	'ExcelApp = CreateObject("Excel.Application")
																	Dim ExcelApp As New Excel.Application 'Create a new Excel Application
																	' Set Excel to run visibly, change to false if you want to run it invisibly
																	'ExcelApp.Visible = True
																	ExcelApp.Visible = False
																	
																	' Suppress prompts (such as the compatibility checker)
																	ExcelApp.DisplayAlerts = False
																	
																	' Check for existing file
																	' Delete file, to avoid error regarding Table
																	If System.IO.File.Exists(myXLS_File) Then System.IO.File.Delete(myXLS_File)
																		
																	Dim oWB
																	If Dir(myXLS_File) <> "" Then
																	' Workbook exists, open it
																	oWB = ExcelApp.Workbooks.Open(myXLS_File)
																	'oExcelSheet = oWB.Worksheets(1)
																	Else
																	' Create a new spreadsheet from template
																	oWB = ExcelApp.Workbooks.Add '(Template: = "C:\Temp\HML_BoM_PO.xlt")
																	End If																	
																						
																						' Insert data into Excel.
																						'With ExcelApp
																						'	.Range("A1").Select
																						'	.ActiveCell.FormulaR1C1 = "Hello, " & myName
																						'End With   
																																					
																						Dim oExcelSheet
																						oExcelSheet = oWB.Worksheets.Item(1)
																						
																						Dim oCells
																						oCells = oExcelSheet.Cells																						
																						
																						' Create column headers
																					    ' First number is Row index, second number is Column Index
																					    oCells.Item(1,  1).Value = "Thumbnail"
																						oCells.Item(1,  2).Value = "QTY"
																					    oCells.Item(1,  3).Value = "Material+Thick+Fabr"
																					    oCells.Item(1,  4).Value = "Part Number"
																						oCells.Item(1,  5).Value = "REV"
																						oCells.Item(1,  6).Value = "Description"
																						oCells.Item(1,  7).Value = "Finishing"
																						oCells.Item(1,  8).Value = "Dimensions" '"Parameters"
																						oCells.Item(1,  9).Value = "Bends"
																						oCells.Item(1, 10).Value = "Tapping"
																						oCells.Item(1, 11).Value = "CSINK"
																						oCells.Item(1, 12).Value = "CBORE"
																						oCells.Item(1, 13).Value = "Under Class Approval"
																						oCells.Item(1, 14).Value = "Mass"																								
																	
																	' Set all of the columns to autofit
																	'ExcelApp.Columns.AutoFit   
																	' Save the file
																	'oWB.SaveAs (myXLS_File)
																	
																	' Close the workbook and the Excel Application
																	' Uncomment if you want to close the xls file at the end
																	'oWB.Close
																	'ExcelApp.Quit
																	'ExcelApp = Nothing'
																	'====================================================================================================
															
															'----------------------------------------------------------------------------------------------------
															sw.WriteLine
															sw.WriteLine
															sw.WriteLine("Parts - " & DictionaryPartsPublish.count & "x")
															sw.WriteLine		
															Dim j As Integer
															For Each pair As KeyValuePair(Of String, Document) In DictionaryPartsPublish
																sw.WriteLine(pair.Key)
																DictionaryAllFilesToBePublished.add(pair.Key, pair.Value)
																DictionaryAllFilesToBePublishedNoQTY.add(Left(pair.Key, InStrRev(pair.Key, "(") -1),Left(pair.Key, InStrRev(pair.Key, "(") -1))
																'IsFileInUse(pair.Key)
															
																		'----------------------------------------------------------------------------------------------------
																		'====================================================================================================
																		' Fill the created Excel file
																		
																						Dim oDoc As Document = pair.Value
																		
																						' Get Properties
																						Dim sPartNumber As String = GetProp(oDoc, "DTP", "Part Number")
																						Dim sRev As String = GetProp(oDoc, "ISI", "Revision Number")
																						Dim sDescription As String = GetProp(oDoc, "DTP", "Description")
																						Dim sMaterial As String = GetProp(oDoc, "DTP", "Material")
																						Dim sThickness As String = GetProp(oDoc, "IUDP", "Thickness")	
																						Dim sFinishing As String  = GetProp(oDoc, "IUDP", "Finishing")
																						Dim sFabrication As String = GetProp(oDoc, "IUDP", "Fabrication")
																						Dim sBends As String = GetProp(oDoc, "IUDP", "Bends")
																						Dim sTAPPING As String = GetProp(oDoc, "IUDP", "TAPPING")
																						Dim sCSINK As String = GetProp(oDoc, "IUDP", "CSINK")
																						Dim sCBORE As String = GetProp(oDoc, "IUDP", "CBORE")
																						Dim sUnderClassApproval As String = GetProp(oDoc, "IUDP", "Under Class Approval")
																						Dim sPartParameters As String = GetProp(oDoc, "IUDP", "PartParameters")
																						Dim sMass As String = GetProp(oDoc, "IUDP", "Mass")
																						Dim sCombinedProductionOutput As String = GetProp(oDoc, "IUDP", "Combined Production Output")
																						
																						sDocType = GetDocumentType_And_SubType(oDoc)
	
																						'Get Fabrication_info Flat, Bend or Unknown					
																						If sFabrication Like "*F*" And sDocType Like "*Sheet_metal*" Then
																							sFabrication_Info = " " & sThickness & " mm Flat"
																						ElseIf sFabrication Like "*B*" And sDocType Like "*Sheet_metal*" Then	
																							sFabrication_Info = " " & sThickness & " mm Bend"
																						Else
																							sFabrication_Info = ""
																						End If
																						
																						' Make 'S', 'Z', Tapping, CSINK and CBORE visible
																						If sTAPPING Like "*Yes*" Or sCSINK Like "*Yes*" Or sCBORE Like "*Yes*" Or sFabrication Like "*S*" Or sFabrication Like "*Z*" Then
																							sFabrication_Info = sFabrication_Info & "+"		
																						End If																		
																						
																						'----------------------------------------------------------------------------------------------------
																						' Add Picture
																																												
																						Dim oThumb As stdole.IPictureDisp
																						Do
																							oThumb = oDoc.Thumbnail
																						Loop While oThumb.Handle<0
																					
																						Dim myPict As New AxHostConverter 
																						Dim oImage As System.Drawing.Image=myPict.GetImageFromIPictureDisp(oThumb)
																						
																						oImage.Save("C:\TEMP\bmptest.bmp",System.Drawing.Imaging.ImageFormat.Bmp)
																						
																						'oCells.Item(j + 2, 1).Value = oImage
																						
																						
																						
																						
																						
																						
																						
																						
																						
																						
																						
																						
																						'Dim tempDoc As Document = pair.Key
																		
''																						' Get the thumbnail image. 
'																						Dim thumbnail As IPictureDisp 'stdole.IPictureDisp 
'																						thumbnail = tempDoc.Thumbnail()
																						
''																						' Convert the IPictureDisp object to an Image. 
'																						'Dim img As Image = Compatibility.VB6.IPictureDispToImage(thumbnail)
																						
'																						'Dim img As Image = pair.Value(thumbnail)
'																						'Document.Thumbnail() As IPictureDisp
'																						'oCells.Item(j + 2, 1).Value = GetProp(pair.Value, "ISI", "Thumbnail")
'																						'oCells.Item(j + 2, 1).Value = img

						' Try to add a picture to Excel
						'xlWorkSheet.Shapes.AddPicture("C:\xl_pic.JPG", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 50, 50, 300, 45)
						'r = oExcelSheet.Cells(5, 2)

						'fileName = "C:\Workingfolder\Projecten\149.0389-PO\70\06-Parts-SS\AISI 304+\AISI 304+   A02095-389.ipt-A Bushing rope pulley Øh17 L=32mm(1x).jpg"
						
						'pictureWidth = 195
						'pictureHeight = 102
						
						'shape = oExcelSheet.Shapes.AddPicture(fileName, Microsoft.Office.Core.MsoTriState.msoTrue, Microsoft.Office.Core.MsoTriState.msoTrue, r.Left, r.Top, pictureWidth * 3 / 4, pictureHeight * 3 / 4)
						        'oExcelSheet.Shapes.AddPicture(fileName, Microsoft.Office.Core.MsoTriState.msoTrue, Microsoft.Office.Core.MsoTriState.msoTrue, i + 2, j + 1, 100, 100)
						'shape.LockAspectRatio = msoTrue
						'shape.ScaleHeight 2, msoTrue, msoScaleFromTopLeft
						
						
						Try
						
						'oExcelSheet.Range("a1").Select()
						'oExcelSheet.Rows(j + 2).select
						'oExcelSheet.Columns(1).select
						'oExcelSheet.Pictures.Insert(fileName)

'							With ExcelApp.oExcelSheet.Pictures.Insert(fileName)
'							    With .ShapeRange
'							        .LockAspectRatio = msoTrue
'							        .Width = 75
'							        .Height = 100
'							    End With
'							    .Left = ExcelApp.oExcelSheet.Cells(j, 20).Left
'							    .Top = ExcelApp.oExcelSheet.Cells(j, 20).Top
'							    .Placement = 1
'							    .PrintObject = True
'							End With
							
							
'							With oExcelSheet.Pictures.Insert(fileName:=imageFileName, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue)
'						        With .ShapeRange
'						            .LockAspectRatio = msoTrue
'						            .Width = destRange.Width
'						            .height = destRange.height '222
'						        End With
'						        .Left = destRange.Left
'						        .Top = destRange.Top
'						        .Placement = 1
'						        .PrintObject = True
'						        .Name = imageName
'						    End With
						
'						ActiveSheet.Pictures.Insert(fileName).Select
'						Selection.Top = Target.Offset(0, 2).Top
'						Selection.Left = Target.Offset(0, 3).Left
'						Selection.ShapeRange.LockAspectRatio = msoFalse
'						Selection.ShapeRange.Height = Target.Offset(0, 2).Height
'						Selection.ShapeRange.Width = Target.Offset(0, 3).Width
						
					
					
						Catch ex As IOException
						
							log.Close()
						
						End Try
													
																		
																		' First number is Row index, second number is Column Index
																		oCells.Item(j + 2,  2).Value = GetQTYfromStr(pair.Key)
																		oCells.Item(j + 2,  3).Value = sMaterial & sFabrication_Info
																		oCells.Item(j + 2,  4).Value = sPartNumber
																		oCells.Item(j + 2,  5).Value = sRev
																		oCells.Item(j + 2,  6).Value = sDescription																		
																		oCells.Item(j + 2,  7).Value = sFinishing	
																		oCells.Item(j + 2,  8).Value = sPartParameters
																		oCells.Item(j + 2,  9).Value = sBends
																		oCells.Item(j + 2, 10).Value = sTAPPING
																		oCells.Item(j + 2, 11).Value = sCSINK
																		oCells.Item(j + 2, 12).Value = sCBORE
																		oCells.Item(j + 2, 13).Value = sUnderClassApproval
																		oCells.Item(j + 2, 14).Value = sMass
																	
															
																		'====================================================================================================
															j = j + 1
															Next
															
																		'----------------------------------------------------------------------------------------------------
																		' Arrange Rows and Columns
																		' Those next lines seems to work																		
																		
																				' Get Last Row and Last Column as numbers
																				With oExcelSheet
																			    	If ExcelApp.WorksheetFunction.CountA(.Cells) <> 0 Then
																			        	lRow = .Cells.Find(What:="*", _
																			                      After:=.Range("A1"), _
																			                      LookAt:=Excel.XlLookAt.xlPart, _
																			                      LookIn:=Excel.XlFindLookIn.xlFormulas, _
																			                      SearchOrder:=Excel.XlSearchOrder.xlByRows, _
																			                      SearchDirection:=Excel.XlSearchDirection.xlPrevious, _
																			                      MatchCase:=False).Row
																				    Else
																				        lRow = 1
																				    End If
																				End With
																				
																				With oExcelSheet
																			    	If ExcelApp.WorksheetFunction.CountA(.Cells) <> 0 Then
																			        	lCol = .Cells.Find(What:="*", _
																			                      After:=.Range("A1"), _
																			                      LookAt:=Excel.XlLookAt.xlPart, _
																			                      LookIn:=Excel.XlFindLookIn.xlFormulas, _
																			                      SearchOrder:=Excel.XlSearchOrder.xlByColumns, _
																			                      SearchDirection:=Excel.XlSearchDirection.xlPrevious, _
																			                      MatchCase:=False).Column
																				    Else
																				        lCol = 1
																				    End If
																				End With
																				
'																				'MessageBox.Show("LRow: " & LRow & vbNewLine & "LCol: " & LCol)
																		
'																		' Filter BOM for Normal or Purchased BOM_structure files
'																		'Filter(oExcelSheet, Normal, lrRow)		
																				
'																    	' This resizes the selection  but, I don't really know what for...
'																		Dim rng As Excel.Range
'																    	'rng = ExcelApp.Cells(1, 1).Resize(lRow, lCol)
'																		'rng = oExcelSheet.Cells(1, 1).Resize(lRow, lCol)
																		
'																		' Create Table
																		oExcelSheet.ListObjects.Add()		
																    	oExcelSheet.ListObjects(1).Name = "Table"
																		
'																		' Set Table Style based on BoM Type
'																		' HML Table Style :
'																		' - Structured All Levels		- Orange 		- TableStyleLight10
'																		' - Structural Single Level		- Black/White	- TableStyleLight15
'																		' - Parts Only Normal			- Yellow 		- TableStyleLight10
'																		' - Purchased					- Blue			- TableStyleLight12		
																		
'																		'If BoMExporter = "Structured - All Levels" Then :oExcelSheet.ListObjects(1).TableStyle = "TableStyleLight10" : End If
'																		'If BoMExporter = "Structured - Single Level" Then :oExcelSheet.ListObjects(1).TableStyle = "TableStyleLight15" : End If
'																		'If BoMExporter = "Parts Only - (Shows components in a flat list)" Then : oExcelSheet.ListObjects(1).TableStyle = "TableStyleLight12" : End If
																		oExcelSheet.ListObjects(1).TableStyle = "TableStyleLight12"
																		
'																		' If BoMExporter = "Purchased" Then : oExcelSheet.ListObjects(1).TableStyle = "TableStyleLight13" : End If 
																		
																		
'																		'**************************************************************************************
'																		' Help
'																		' xlCenter is a member of Microsoft.Office.Interop.Excel.Constants.
'																		' Since you assigned Microsoft.Office.Interop.Excel To the name Excel, you can reference that constant Like this...
'																		' oExcelSheet.Range("H15:H16").VerticalAlignment = Excel.Constants.xlCenter
'																		'**************************************************************************************
																					
																		'Freeze Header and Column
																		FreezeHeader(oExcelSheet, 1, 7)
																		'FreezeHeader(oExcelSheet, 1, 2)
																		
																		' Autofit all Columns except the 1st one with pictures
																		oExcelSheet.Columns("B:" & GetExcelColumnName(LCol)).EntireColumn.AutoFit
																		'ExcelApp.Columns.AutoFit
																		
																		' Center Columns Horizontaly
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "QTY")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "REV")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "Fabrication")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "Bends")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "Tapping")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "CSINK")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "CBORE")
																		HorizontalAlignment_xlCenter(oExcelSheet, lCol, "Under Class Approval")																		
																		
'																		' Delete Columns
'																		'DeleteColumn(oExcelSheet, lCol, "BOM Structure")
'																		'DeleteColumn(oExcelSheet, lCol, "Stock Number")
'																		'DeleteColumn(oExcelSheet, lCol, "Spare part")
'																		'DeleteColumn(oExcelSheet, lCol, "Oem part number")
'																		'DeleteColumn(oExcelSheet, lCol, "Maintenance")
'																		'DeleteColumn(oExcelSheet, lCol, "Manufacturer")
'																		'DeleteColumn(oExcelSheet, lCol, "Vendor")
'																		'DeleteColumn(oExcelSheet, lCol, "Project")
'																		'DeleteColumn(oExcelSheet, lCol, "Filename")
																		
																		'oExcelSheet.Columns(1).ColumnWidth = 19
																		oExcelSheet.Rows.RowHeight = 68.25
																		oExcelSheet.Rows(1).RowHeight = 15
																		
'																		' Untill here above lines seems to work		
																		
																		'====================================================================================================
																		' Set all of the columns to autofit
																		'ExcelApp.Columns.AutoFit   
																		' Save the file
																		oWB.SaveAs (myXLS_File)
																		
																		' Close the workbook and the Excel Application
																		' Uncomment if you want to close the xls file at the end
																		oWB.Close
																		ExcelApp.Quit
																		ExcelApp = Nothing'
																		'====================================================================================================

[checkcheck_master]

Sorry Krieg, here I am again.

I see that PNG is also possible with some of the same file sizes like max 400 Kb, so that's great.

Then I like to know how to get these in or over a cell.

Thanks in advance.

'---------------------------------------------------------------------------
' Add Picture
																			
Dim oThumb As stdole.IPictureDisp
Do
	oThumb = oDoc.Thumbnail
Loop While oThumb.Handle<0

Dim myPict As New AxHostConverter 
Dim oImage As System.Drawing.Image=myPict.GetImageFromIPictureDisp(oThumb)

'oImage.Save("C:\TEMP\bmptest.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
oImage.Save(pair.Key & "-Test.Png",System.Drawing.Imaging.ImageFormat.Png)

'oCells.Item(j + 2, 1).Value = oImage

[checkcheck_master]

Hello.

I managed to get the images into Excel.
And in the simplest way I think, almost not worth looking at but see code.
The images are already there when the BoM could be created, so these images are now used.
It is to my/our satisfaction, although I don't really have a reference it seems to go fast enough.
I read that Cell.Select could be slowing down?
No reference for this either, but I don't use it for posting the image.
It is in any case a relief or a funny sight to see the creation of the BoMs fully automatic and to obtain BoMs with absolute numbers on them.
I also discovered DictionaryOfDictionaries, man that's cool.
Collect the whole lot in a flash and at the end of that process ask what to do with it, genius.
Any collection of Parts/Sub Assys within a 'Combined Production Output Assembly' (I stopped using Phantom based on Parent relationships), and/or Weldment go as Dictionary to DictionaryOfDictionaries to open an Excel later and iterate over the Key and Value to fill the rows.
The Parts are pretty much the same, they are placed in a Dictionary based on our BreakDownStructure and then FE/SS to make a BoM at the end.

'----------------------------------------------------------------------------------------------------
' Add Picture
oImage = pair.Value & ".jpg"

Dim pic As Object																						
With pic
	'.Top = ExcelApp.activecell.Top
	'.Left = ExcelApp.activecell.Left		
	'.Width = ExcelApp.activecell.Width
	'.Height = ExcelApp.activecell.Height
	'.Anchor = range

End With

'pic = ExcelApp.ActiveSheet.Shapes.AddPicture(oImage, False, True, 0, 100, 150, 150)
' See above, pos x, pos y, width and height, width 150 is what we need when enlarging the picture regarding the resolution
pic = ExcelApp.ActiveSheet.Shapes.AddPicture(oImage, False, True, 0, yPosPic, 119.25, 123)
																						
yPosPic = yPosPic + rowHeight