can grow / can shrink image control Access 2007 report

[newguytom]

What I am wanting to do is create layout drawings of a product that has modular components that can be configured in any configuration. Each image of a modular part is the same width with a variable height so when they are displayed in a report they create a 2D image of the finished product.

The user would simply choose the part that they want in the drawing (via a yes/no data type) and sort the order by a number.

I have check the properties in the report for an image control and I can't seem to be able to find a way to do this like you can with a text box. I was hoping that somebody could point me in the right direction or if anybody would know a VBA code that could accomplish this.

Thank you.

[ADezii]

@newguytom
You can dynamically control the Height, Width, Top, and Left Properties of an Image Control for each Record in the Format() Event of the Detail Section of a Report. The following code, based on the Employees Table as the Record Source of a Report, will maintain an Image Control's original dimensions if the Value in the Country Field = 'USA' otherwise it will reduce the Height and Width Properties by 50% while increasing the Left and Top Properties by 50%. Hope this helps.

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
'Measurements in Twips where 1,440 Twips = 1 inch
Const conORIG_IMAGE_HT As Single = (1.375 * 1440)
Const conORIG_IMAGE_WD As Single = (1.6667 * 1440)
Const conORIG_IMAGE_LEFT As Single = (1.375 * 1440)
Const conORIG_IMAGE_TOP As Single = (0.5417 * 1440)
 
With Me![Image1]
  If Me![Country] = "USA" Then
    .Height = conORIG_IMAGE_HT
    .Width = conORIG_IMAGE_WD
    .Left = conORIG_IMAGE_LEFT
    .Top = conORIG_IMAGE_TOP
  Else
    .Height = (conORIG_IMAGE_HT) / 2
    .Width = (conORIG_IMAGE_WD) / 2
    .Left = (conORIG_IMAGE_LEFT * 1.5)
    .Top = (conORIG_IMAGE_TOP * 1.5)
  End If
End With
End Sub

[newguytom]

Hi ADezii,

Thank you for the code, it sounds like it is what i am after. I have tried it however I get an error "Run-time error 438, Object doen't support this property or method" and the debugger stops on " .Height = conORIG_IMAGE_HT".

I am not sure about this, can you shed some light?

Regards

[ADezii]

@newguytom
Kindly post the code using the appropriate Code Tags.

[newguytom]

First of all, a big thanks to everybody that has contributed so far. Below is the code that I have found that does most of the job

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
 
If (Me.length) = "0.0265" Then
Me.Image18.Picture = Me.path
Me.Image18.Visible = True
Me.Image18.Height = "285"
Me.Image18.Width = "2000"
 
Else
 
If (Me.length) = "0.1325" Then
Me.Image18.Picture = Me.path
Me.Image18.Visible = True
Me.Image18.Height = "2550"
Me.Image18.Width = "2000"
 
Else
 
If (Me.length) = "0.2385" Then
Me.Image18.Picture = Me.path
Me.Image18.Visible = True
Me.Image18.Height = "4500"
Me.Image18.Width = "2000"
 
Else
 
Me.Image18.Picture = Me.path
Me.Image18.Visible = True
Me.Image18.Height = "285"
Me.Image18.Width = "2000"
 
End If
End If
End If
 
End Sub
 

This works well however if I have multiple modular components that are the same length the above code will only modify the size of the image control for the first one in the table, the second component that is the same length does not size the image control correctly.

I hope somebody can help me with this.

Regards

[ADezii]

@newguytom

If (Me.length) =

makes no sense to me, what are you trying to accomplish, and what is Me supposed to represent?

[newguytom]

Sorry, I copied the wrong code, please see below:

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
 
If [length] = "0.0265" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "285"
Image18.Width = "2000"
 
Else
 
If [length] = "0.1325" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "2550"
Image18.Width = "2000"
 
Else
 
If [length] = "0.2385" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "4500"
Image18.Width = "2000"
 
Else
 
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "285"
Image18.Width = "2000"
 
End If
End If
End If
 
End Sub

I have a table that has two columns, one called path which contains the file path for the image and one called length which contains the physical size of the component and controls the size of the image control.

Attached is what I am getting. As you can see the first image with the length of 0.0265 has the correct size however the second one at the bottom is not correct.

Please let me know what you think.

regards.

[newguytom]

A better example of what is going on with a border around the image control

[ADezii]

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim img As Image
 
Set img = Me![Image18]
Me![Image18].Picture = Me![Path]
 
img.Visible = True
 
Select Case Me![Length]
  Case "0.0265"
    img.Height = 285        'Height & Width expressed
    img.Width = 2000        'in Twips and are not Strings
  Case "0.1325"
    img.Height = 2550
    img.Width = 2000
  Case "0.2385"
    img.Height = 4500
    img.Width = 2000
  Case Else
    img.Height = 285
    img.Width = 2000
End Select
End Sub

[newguytom]

Thanks ADezii for the code however I am still having the same problem. If the larger image comes first (height = 4500) the image control is set at this height for all image records that come after it.

So what I would have to do is sort the images in order of size from smallest to largest however this defeats the purpose as then the images are in the wrong order. I don't know if the image control size can be set for each record as it formats or whether it will only can grow not can shrink.

Regards.

[ADezii]

@newguytom
Are you able to Upload the Database, so that I can have a look at it? All that would be needed is the Report and some Sample Data from its Record Source.

[newguytom]

Hi ADezii,

I really appreciate your help however I have found the solution!

I have used:

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
 
If [length] = "0.0265" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "285"
Image18.Width = "2000"
Me.Section(acDetail).Height = "285"
 
Else
 
If [length] = "0.1325" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "2550"
Image18.Width = "2000"
Me.Section(acDetail).Height = "2550"
 
Else
 
If [length] = "0.2385" Then
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "4500"
Image18.Width = "2000"
Me.Section(acDetail).Height = "4500"
 
Else
 
Image18.Picture = [path]
Image18.Visible = True
Image18.Height = "4500"
Image18.Width = "2000"
Me.Section(acDetail).Height = "4500"
 
 
End If
End If
End If
 
End Sub

The extra piece of code shrinks the area to the size of the image if it is smaller than the one that came before it.

My next challenge to convert the following data into a table by some sort of append. Below will be what the table will hold:

Type Quantity

part1 1
part2 3
part6 2
part8 1

So this table would say there are 7 parts

I need to append it somehow to a new table so the data looks like:

Type Quantity

part1 1
part2 1
part2 1
part2 1
part6 1
part6 1
part8 1

This table also says that there are 7 parts however there is a line for each part.

Do you have any ideas?

Regards.

[ADezii]

ASSUMPTIONS:

1. Your Table name is tblOriginal with the following Fields:
   • [Type] {STRING}
   • [Quantity] {LONG]
2. Create a New Table named tblNew with the following Fields:
   • [Type] {STRING}
   • [Quantity] {LONG]

Dim MyDB As DAO.Database
Dim rstOrig As DAO.Recordset
Dim rstNew As DAO.Recordset
Dim lngCtr As Long
 
Set MyDB = CurrentDb
Set rstOrig = MyDB.OpenRecordset("tblOriginal", dbOpenForwardOnly)
 
'Clear the Results Table (tblNew)
CurrentDb.Execute "DELETE * FROM tblNew;", dbFailOnError
 
With rstOrig
  Do While Not .EOF
    For lngCtr = 1 To ![Quantity]
      CurrentDb.Execute "INSERT INTO tblNew ([Type], [Quantity]) VALUES ('" & ![Type] & _
                        "', 1);", dbFailOnError
    Next
      .MoveNext
  Loop
End With
 
rstOrig.Close
Set rstOrig = Nothing

[newguytom]

Hi ADezii,

Once again thanks for the code.

Please excuse my inexperience however were would I put this code? This is the first time that I have attempted something like this.

Regards.

[ADezii]

@newguytom
Because of the nature of the code, it can be placed anywhere: in the Click() Event of a Command Button, Open() Event of a Form. etc...

[newguytom]

Hi ADezii,

Mate it works a treat, you are worth your weight in gold. You have not just helped my but anybody else who searches for these solutions in the future.

Regards,

Tom.

[newguytom]

Hi ADezii,

I have another one that I can't figure out you may be able to help me with. I would like take the rows that are in a column and append them to seperate columns so that each row is in a new column. For example:

current table

column1

desc1
desc2
desc3
desc4

changes to:

column1 column2 column3 column4

desc1 desc2 desc3 desc4

Any ideas?

I have tried a crosstab query however it puts each description on a different row and I require them to all be on the first row as they will be going into the footer of a report.

Regards.

[ADezii]

1. Are the Number of Records in Column1 constant?
2. If so, how many Records?
3. What is the Name of the Table containing Column1?

[newguytom]

Hi ADezii,


The number of records are not constant by will be from 2 - 6 records. The records are actually in a query named "extdesc".

Any help would be great.

I thought that I could append the recods into a table with an autonumber field and then put the table into a crosstab query with the autonumbers being the column headings. If I did this the report will not recognise autonumber column headings as they will change everytime new records are appended into the table thereby changing the control source name.

I concatenated the rows together in a query however this takes the character count to over 255 so it cuts a lot of the text off and besides that looks quite messy and hard to read.

regards.

[ADezii]

@newguytom
I do have a solution for you and will return later with it.

[ADezii]

I've created what I feel is a comprehensive, well commented, Public Sub-Routine Procedure complete with Error Handling that will produce the desired results in a dynamically created Table named tblResults. Before you Copy and Paste the Code, just a few details:

1. The Routine accepts a single Argument, namely the Name of the Single-Field Table whose Records you wish to transpose into Columns of the newly created Table. You can use the Name of a Query with slight modifications.
2. The Code first performs a check on the passed Argument (Table Name) to see if it is an Empty String.
3. The Code then performs some Validations on the Table Name (strTableName) to see if it actually exists, and if it does, are there Records contained within.
4. If all is well, the Results Table (tblResults) is dynamically created with the Number of Columns (Column1 to Column...N) equal to the Number of Records in the passed Table. I'll leave it to you to make sure the Number of Records does not exceed the Access Column Limit of 255. It has been tested and does work with 255 Columns.
5. If tblResults already exists, an Error is generated then trapped in the Error Handler where it is Deleted and Code Execution then returns to the Line that generated the Error.
6. tblResults is then populated and opened Maximized.
7. Copy and Paste the Code - I've also included a Sample Call for you.
   

   Public Sub Transpose(strTableName As String)
   On Error GoTo Err_Transpose
   Dim strSQL As String
   Dim tdf As DAO.TableDef
   Dim blnTableExists As Boolean
   Dim intNumOfRecs As Integer
   Dim intCols As Integer
   Dim rst2 As DAO.Recordset
    
   'If an Empty String is passed get outta Dodge!
   If strTableName = "" Then Exit Sub
    
   'Does the Table actually exist?
   For Each tdf In CurrentDb.TableDefs
     If tdf.Name = strTableName Then blnTableExists = True: Exit For
   Next
    
   'Analyze blnTableExists, if it doesn't exist, outta Dodge!
   If Not blnTableExists Then
     MsgBox "The Table [" & strTableName & "] does not exist", vbExclamation, "No Table Found"
       Exit Sub
   End If
    
   'We know that the Table now exists, but does it contain Records?
   intNumOfRecs = DCount("*", strTableName)
   If intNumOfRecs = 0 Then
     MsgBox "The Table [" & strTableName & "] contains no Records", vbExclamation, "No Records Found"
       Exit Sub
   End If
    
   'Finally, we are good to go. Dynamically create tblResults with the Number of Columns
   'equal to intNumOfRecs in strTableName
   strSQL = "CREATE TABLE tblResults ("
   For intCols = 1 To intNumOfRecs
     strSQL = strSQL & " Column" & intCols & " Text (50),"
   Next
   strSQL = Left(strSQL, Len(strSQL) - 1) & ")"
    
   CurrentDb.Execute strSQL    'Table & Columns now created
    
   'Let's populate tblResults, Column1 to Cloumn...N based on the number of Records in strTableName
   Dim MyDB As DAO.Database
   Dim rst As DAO.Recordset
    
   Set MyDB = CurrentDb
   Set rst = MyDB.OpenRecordset(strTableName, dbOpenSnapshot)
   Set rst2 = MyDB.OpenRecordset("tblResults", dbOpenDynaset)
    
   For intCols = 0 To intNumOfRecs - 1
     If intCols = 0 Then
       rst2.AddNew
         rst2.Fields(intCols) = rst.Fields(0)
       rst2.Update
     Else
       rst2.MoveFirst      'Always return to the 1st Record
         rst2.Edit
           rst2.Fields(intCols) = rst.Fields(0)
         rst2.Update
     End If
       rst.MoveNext
   Next
    
   'Clean Up chores
   rst.Close
   rst2.Close
   Set rst = Nothing
   Set rst2 = Nothing
    
   DoCmd.OpenTable "tblResults", acViewNormal, acReadOnly
   DoCmd.Maximize
    
   Exit_Transpose:
     Exit Sub
    
   Err_Transpose:
     If Err.Number = 3010 Then     'tblResults exists, DELETE it!
       CurrentDb.TableDefs.Delete "tblResults"
         Resume
     Else
       MsgBox Err.Description, vbExclamation, "Error in Transpose()"
         Resume Exit_Transpose
     End If
   End Sub

8. Sample Call:
   

   Call Transpose("Table1")

[newguytom]

Hi ADezii,

Thank you for the code, I enjoyed the comments that you included.

I have put the code into a module however I am not sure about the sample call that you have included and I cannot seem to get the code to run.

I don't think that I have done anything like this before. I would appreciate it if you could send some more info.

Regards.

[newguytom]

Hi ADezii,

I have got it to work temporarily, will be testing it later.

Thanks!

[ADezii]

You are quite welcome. At first the code looks quite daunting, but keep in mind that much of it includes Error Handling and Validation on the Table Name.

[newguytom]

Hi ADezii,

As usual the code worked like a charm and you are correct it does look a bit daunting however with your explanation it was easy to use.

I changed it slightly so that it would always generate 15 columns, see below:

strSQL = "CREATE TABLE tblResults ("
For intCols = 1 To 15
strSQL = strSQL & " Column" & intCols & " Text (255),"

There is one other thing I would like to be able to do however it is a bit difficult to explain. For example I have included code to force a line to be drawn the length of the report detail regardless of how many records it contains, in my case it contains the path to any number of image that when put together create a drawing. I would to be able to do the same with a text box control, force it to run the length of the report detail without interrupting the images that crate the drawing.

I am pretty sure that this is not possible however seeing as you have I lot of knowledge of Access I would like to ask you first before giving up. Do you have any ideas?

Regards.

[ADezii]

@newguytom
Sorry, not really sure what you mean.

[newguytom]

Hi ADezii,

I have attached an image, hopefully it can explain what I am trying to say.

Regards

[ADezii]

1. Create a Text Box, and let's call it Text1.
2. Position this Text Box anywhere near the Upper Left Corner of the Detail Section (code will precisely position it).
3. Set any Height for this Text Box. Again, the code will determine this.
4. Set its Width to exactly what you would like it to be.
5. Execute the following code which will:
   • Position the Text Box at the Top of the Detail Section.
   • Position the Text Box to the extreme Left Side of the Detail Section.
   • Give the Text Box a Solid Red Border Color 2 Points in Width.
   • Make its Back color Opaque and fill it in Blue.
   • Precisely set its Height to that of the Detail Section.

   Dim txt As TextBox
    
   Set txt = Me![Text6]
    
   With txt
     .Top = 0                  'Top of Detail Section
     .Left = 0                 'Leftmost of Detail Section
     .BorderStyle = 1          'Solid
     .BorderColor = vbRed      'Border Color of Text Box
     .BorderWidth = 2          'Width in Points
     .BackStyle = 1            'Normal/Opaque
     .BackColor = vbBlue       'Blue Fill Color
     .Height = Me.Section(acDetail).Height         'Height of Text Box
   End With

6. All the above Properties, except Height in this case, can be set manually. I set them programmatically only for demo purposes.
7. I'll leave it to you to figure out how to create the Right Text Box, but if you are stuck, don't hesitate to ask.

[newguytom]

Hi ADezii,

Thanks for the code however this is not quite what I am after (unless I have done something wrong). This repeats the text box for each record whereas I was after a text box or label that would not repeat itself and stretch the entire length of the report detail section regardless of how many record there were.

Regards..

[ADezii]

@newguytom
Here's a shot-in-the-dark, try the following Line of Code in the Report's Page() Event as illustrated:

Private Sub Report_Page()
  Me.Line (0, 0)-(250, Me.ScaleHeight), vbRed, BF
End Sub

[newguytom]

Hi ADezii,

I have tried the code and in the print preview it runs a thick red line from the top to the bottom of the page.

It is pretty much what I am after except with a text box or label.

Regards.

[newguytom]

Hi ADezii,

Found a solution! I have put a background image on the page containing the text that I want where I want it. Not quite as fun as working with code but does the job.

Thank you for your help and support!

Regards,

Tom.

[ADezii]

@newguytom
Glad you found an acceptable solution, nice job.