Other options......
What about creating the report in Access (with images), then exporting the report to a PDF file?
Or using Access automation with Powerpoint, then exporting as PDF?
Easier than trying to put lots of images in Excel (IMO).
My $0.02................
What's the fun in that?
Code:Dim xlApp As New Excel.Application Dim myBook As Workbook Dim mySheet As Worksheet Dim myShape As Shape Dim myRange As Range Set myBook = xlApp.Workbooks.Add Set mySheet = myBook.Worksheets(1) mySheet.Name = "ShapeExample" Set myRange = mySheet.Cells(4, 9) Set myShape = mySheet.Shapes.AddPicture("C:\Test\Pictures\samplePhoto.jpg", msoTrue, msoFalse, myRange.Left, myRange.Top, 500, 500) myBook.SaveAs ("C:\Test\ExcelFiles\TestFile.xlsx") MsgBox "Complete" myBook.Close xlApp.Quit Set myShape = Nothing Set mySheet = Nothing Set xlApp = Nothing
Now you have mentioned. If I really could export to Excel as shapes and link to the images. Will the images be also linked to the path, or will they be embedded in the excel? I am guessing adding one picture is easy. And adding images according to the records will be complicated.What's the fun in that?
Code:Dim xlApp As New Excel.Application Dim myBook As Workbook Dim mySheet As Worksheet Dim myShape As Shape Dim myRange As Range Set myBook = xlApp.Workbooks.Add Set mySheet = myBook.Worksheets(1) mySheet.Name = "ShapeExample" Set myRange = mySheet.Cells(4, 9) Set myShape = mySheet.Shapes.AddPicture("C:\Test\Pictures\samplePhoto.jpg", msoTrue, msoFalse, myRange.Left, myRange.Top, 500, 500) myBook.SaveAs ("C:\Test\ExcelFiles\TestFile.xlsx") MsgBox "Complete" myBook.Close xlApp.Quit Set myShape = Nothing Set mySheet = Nothing Set xlApp = Nothing
You can embed the image by changing one of the arguments. I think it is the one here in red.
samplePhoto.jpg", msoTrue, msoFalse, myRange.Left
It is hard to say how difficult it would be to get everything to format nicely. If the images are many different sizes, you will need code to handle that. Different sized images might make your spreadsheet unreadable or very difficult to read. You might have to create many named ranges to manage the export process. It could be huge or it could be not too bad.
There may be another solution. It depends on the business rules. Excel may be the way. But, as others have mentioned, managing this with Excel will not be simple.
The code you are using sets the width and height of the images at the same time inserting to the Excel.You can embed the image by changing one of the arguments. I think it is the one here in red.
samplePhoto.jpg", msoTrue, msoFalse, myRange.Left
It is hard to say how difficult it would be to get everything to format nicely. If the images are many different sizes, you will need code to handle that. Different sized images might make your spreadsheet unreadable or very difficult to read. You might have to create many named ranges to manage the export process. It could be huge or it could be not too bad.
There may be another solution. It depends on the business rules. Excel may be the way. But, as others have mentioned, managing this with Excel will not be simple.
If the sizes you are referring to the file size, I have limited the user to only be able to select image sizes under 200k, so that should have solved the 1st part of the sizing problem for the Excel.Code:shapes.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
Thank you,
Jo
I was thinking about the dimensions and having to go after the JPG's extended file properties. Also, this would affect the layout and possibly make the spreadsheet aesthetically unappealing.
Hello,What's the fun in that?
Code:Dim xlApp As New Excel.Application Dim myBook As Workbook Dim mySheet As Worksheet Dim myShape As Shape Dim myRange As Range Set myBook = xlApp.Workbooks.Add Set mySheet = myBook.Worksheets(1) mySheet.Name = "ShapeExample" Set myRange = mySheet.Cells(4, 9) Set myShape = mySheet.Shapes.AddPicture("C:\Test\Pictures\samplePhoto.jpg", msoTrue, msoFalse, myRange.Left, myRange.Top, 500, 500) myBook.SaveAs ("C:\Test\ExcelFiles\TestFile.xlsx") MsgBox "Complete" myBook.Close xlApp.Quit Set myShape = Nothing Set mySheet = Nothing Set xlApp = Nothing
I tried to used the code you wrote in the previous posts. It popped out error msg box saying "The specified value is out of range." Does that mean my row height won't fit the image? But I suppose the image should be floating. No limit on the row height. Then what does that mean?
Thank you for your reply!
Which line did it error on? If it was on the Set myRange, you need to specify a column index and a row index. I think it starts at 1, 1
So I think D6 would translate to 4, 6
If you want multiple cells, you need to play around with Ranges vs Range. I have always managed ranges by using Named ranges within a template. So, exported data would be predestined for an existing file with an existing named range. In your case, if you need multiple cells, you would need to define your range on the fly.
I tried with only using your code, which did not work. But then I tried putting your code into my code. I finally could get the ONE image into the excel.Which line did it error on? If it was on the Set myRange, you need to specify a column index and a row index. I think it starts at 1, 1
So I think D6 would translate to 4, 6
If you want multiple cells, you need to play around with Ranges vs Range. I have always managed ranges by using Named ranges within a template. So, exported data would be predestined for an existing file with an existing named range. In your case, if you need multiple cells, you would need to define your range on the fly.
Now it is the hard part to get multiple images according to the records.Code:Option Explicit 'Enter Location of your Template Here Const ExcelTemplate = "\\nas\Database\Product Development\MasterList\QuoteSheetTemplate.xlsx" 'Enter the Folder Directory to save results to Const SaveResutsFldr = "\\nas\Database\Product Development\MasterList" Sub CreateWorkbook() Dim dbs As DAO.Database Dim qdf As DAO.QueryDef Dim strSQL As String strSQL = "SELECT * FROM QuoteItems WHERE Lognumber='" & Forms![QuoteLog]![LogNumber] & "';" Set dbs = CurrentDb With dbs .QueryDefs.Delete ("myQuery") Set qdf = dbs.CreateQueryDef("myQuery", strSQL) .Close End With Application.RefreshDatabaseWindow Dim SaveAsStr As String Dim ExcelApp As Excel.Application Dim WB As Excel.Workbook Dim mySheet As Excel.Worksheet Dim myShape As Excel.Shape Dim myRange As Excel.Range Dim qry As QueryDef Dim i As Integer Dim c As Integer c = DCount("*", "myQuery") + 9 'Create Reference to Run Excel Set qry = CurrentDb.QueryDefs("myQuery") Set ExcelApp = CreateObject("Excel.Application") 'Create Reference to your Table Dim T As Recordset Set T = qry.OpenRecordset 'Loop through all Record on Table If Not (T.BOF And T.EOF) Then T.MoveFirst End If Do While Not T.EOF 'Open Your Excel Template Set WB = ExcelApp.Workbooks.Open(ExcelTemplate) Set mySheet = WB.Worksheets(1) mySheet.Name = Forms![QuoteLog]![LogNumber] For i = 10 To c 'Enter your data from your table here to the required cells Set myRange = mySheet.Range("A" & i) Dim StrProductPic As String StrProductPic = "\\nas\database\backup\image.jpg" Set myShape = mySheet.Shapes.AddPicture(StrProductPic, True, False, myRange.Left, myRange.Top, -1, -1) myShape.Width = 100 mySheet.Cells(3, 41).Value = Forms![QuoteLog]![LogNumber] mySheet.Cells(3, 2).Value = Forms![QuoteLog]![CustomerName] mySheet.Cells(4, 41).Value = Forms![QuoteLog]![SentDate] mySheet.Range("B" & i) = T("LogNumber") mySheet.Range("C" & i) = T("ProductSpec") Dim strExcel As String Dim n As Integer strExcel = "=IF(A" & i & " = """"," & """EMPTY""" & "," & """FILLED""" & ") " mySheet.Range("D" & i).Formula = strExcel 'Repeat this line for each piece of data you need entered 'Changing the Sheet name, cell range, a field name as per your requirements 'WB.Wor... 'WB.Wor... T.MoveNext Next i i = i + 1 Loop 'Save and Close the Workbook SaveAsStr = SaveResutsFldr & "\" & [Forms]![QuoteLog].LogNumber & "_" & [Forms]![QuoteLog].CustomerName & "_" & Format(Now(), "yymmdd") & ".xlsx" WB.SaveAs SaveAsStr WB.Close Set WB = Nothing 'Move to the Next Record 'Close down the Excel Application ExcelApp.Quit Set ExcelApp = Nothing Shell "EXCEL.EXE """ & SaveAsStr & "", vbNormalFocus End Sub
Thank you for your input.
Jo
The code I posted was copied straight out of a working example. If the paths are correct, it should work. However, incorrect paths would not generate the error you experienced.
One thing you should take note of is how I used the New keyword. When you Dimensioned your variable for the application, you did not instantiate it right away. So, if you used your declarations, you might have gotten that error. I would have expected something a little different though.
Dim ExcelApp As Excel.Application
Where mine is
Dim xlApp As New Excel.Application
and then I go straight to
Set myBook = xlApp.Workbooks.Add
...
You have one image path hardcoded in there. Did the same image get duplicated through multiple rows? Looks like it should have. Maybe you did not get the correct count.
Looks like you are starting at 10
For i = 10 To c
I can't remember, but I think these cells are 1 based index.
so maybe
For i = 1 To T.Count
or if you want to start at the 10th row
For i = 10 To T.Count
I have tried with T.count, but it did not work. So I am stuck with:The code I posted was copied straight out of a working example. If the paths are correct, it should work. However, incorrect paths would not generate the error you experienced.
One thing you should take note of is how I used the New keyword. When you Dimensioned your variable for the application, you did not instantiate it right away. So, if you used your declarations, you might have gotten that error. I would have expected something a little different though.
Dim ExcelApp As Excel.Application
Where mine is
Dim xlApp As New Excel.Application
and then I go straight to
Set myBook = xlApp.Workbooks.Add
...
You have one image path hardcoded in there. Did the same image get duplicated through multiple rows? Looks like it should have. Maybe you did not get the correct count.
Looks like you are starting at 10
For i = 10 To c
I can't remember, but I think these cells are 1 based index.
so maybe
For i = 1 To T.Count
or if you want to start at the 10th row
For i = 10 To T.Count
c = DCount("*", "myQuery") + 9
Yes. I have one image path hardcorded in there. It duplicated through multiple rows. Now I am trying to make the image path as variant which varies when it loop to different records.
I also have another idea to input the string of the path into Excel first. And then command Excel to insert the images based on the records on the Excel. This feels workable.
Jo
You have too much jammed in there. Take a step back and get an abstract for something small. Maybe forget the picture for right now and write some records to your worksheet.
You are going to enumerate some stuff to get things dynamic. So, you are going to need a recordcount. You are also going to need to do a little more with DAO.
You should not be doing this
mySheet.Cells(3, 41).Value = Forms![QuoteLog]![LogNumber]
You should use a DAO recordset to write to a cell.
mySheet.Cells(x, y).Value = rs![FieldName]
To get the correct value of a field, you need to open your recordset. I suggest getting it from a Named and Saved Query object. No query defs needed.
Dim rs as dao.recordset
set rs = currentdb.openrecordset("qyrName", dbopenSnapshot)
rs.MoveLast 'get count
rs.Movefirst
dim intCount = rs.Recordcount 'maybe its rs.count
Now you can start your loop and get something like
mySheet.Cells(1, 1).Value = rs![FieldName]
to get the second dimension of your array (that is your cell coordinates). You could probably hard code the known number of fields and create a second loop. Another approach may be to use a multidimensional array.
The thing is that "mySheet.Cells(3, 41).Value = Forms![QuoteLog]![LogNumber]" will only have one. It does not loop.You have too much jammed in there. Take a step back and get an abstract for something small. Maybe forget the picture for right now and write some records to your worksheet.
You are going to enumerate some stuff to get things dynamic. So, you are going to need a recordcount. You are also going to need to do a little more with DAO.
You should not be doing this
mySheet.Cells(3, 41).Value = Forms![QuoteLog]![LogNumber]
You should use a DAO recordset to write to a cell.
mySheet.Cells(x, y).Value = rs![FieldName]
To get the correct value of a field, you need to open your recordset. I suggest getting it from a Named and Saved Query object. No query defs needed.
Dim rs as dao.recordset
set rs = currentdb.openrecordset("qyrName", dbopenSnapshot)
rs.MoveLast 'get count
rs.Movefirst
dim intCount = rs.Recordcount 'maybe its rs.count
Now you can start your loop and get something like
mySheet.Cells(1, 1).Value = rs![FieldName]
to get the second dimension of your array (that is your cell coordinates). You could probably hard code the known number of fields and create a second loop. Another approach may be to use a multidimensional array.
Based on my second idea of get the picture after exporting the data. It works with Excel VBA.
My Excel vba code:
Now I will try putting this into Access to make it work!Code:Option Explicit Sub Picture() Dim pictureNameColumn As String 'column where picture name is found Dim picturePasteColumn As String 'column where picture is to be pasted Dim picturePath As String 'picture name Dim lastPictureRow As Long 'last row in use where picture names are Dim pictureRow As Long 'current picture row to be processed pictureNameColumn = "E" picturePasteColumn = "A" pictureRow = 10 'starts from this row 'error handler On Error GoTo Err_Handler 'find row of the last cell in use in the column where picture names are lastPictureRow = Cells(Rows.Count, pictureNameColumn).End(xlUp).Row 'stop screen updates while macro is running Application.ScreenUpdating = False 'loop till last row Do While (pictureRow <= lastPictureRow) picturePath = Cells(pictureRow, "E") 'This is the picture name 'if picture name is not blank then If (picturePath <> vbNullString) Then 'check if pic is present If (Dir(picturePath) <> vbNullString) Then Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted ActiveSheet.Pictures.Insert(picturePath).Select 'Path to where pictures are stored With Selection .Left = Cells(pictureRow, picturePasteColumn).Left .Top = Cells(pictureRow, picturePasteColumn).Top .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Height = 100# .ShapeRange.Width = 130# .ShapeRange.Rotation = 0# End With Else 'picture name was there, but no such picture Cells(pictureRow, picturePasteColumn) = "No Picture Found" End If Else 'picture name cell was blank End If 'increment row count pictureRow = pictureRow + 1 Loop Exit_Sub: Range("A10").Select Application.ScreenUpdating = True Exit Sub Err_Handler: MsgBox "Error encountered. " & Err.Description, vbCritical, "Error" GoTo Exit_Sub End Sub