D
Derek Dowle
I have created a database using Excel 2003 and VBA.
A worksheet ‘form’ enables the user to view records. Once a record number
is entered into a cell on the form the VLOOKUP function finds the relevant
data to populate the form from another worksheet that contains the database.
One of the fields (cell) on the ‘database’ worksheet contains the file
name of a picture file.
On the ‘form’ worksheet is an ‘Image’ control to show the picture named in
the database.
Once a record number is entered onto the ‘form’ the following code places
the name of the picture file into the picture property of the Image control
and the picture is displayed on the ‘form’ worksheet.
Before the code is run the size of the workbook is approximately 2.5Mb.
After the code is run the size of the workbook increases to approximately
25Mb. The picture file is a .jpg and is less than 1Mb in size.
Why does the file size increase after running code?
How can I prevent the file from increasing so dramatically in size?
Any assistance will be most welcome.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intCellValue As Integer
Dim intTopValue As Integer
Dim strImgName As String
Dim imgPath
Dim strName As String
Dim strPath As String
Dim picPicture As IPictureDisp
If ActiveCell = Cells(5, 3) Then
On Error GoTo ErrorHandler
myActiveCell = ActiveCell.Address
intCellValue = Cells(5, 3).Value 'Record Number
intTopValue = Cells(1, 15).Value 'Last Record Number
varWhat = VarType(intCellValue)
If intCellValue > 0 Then
If intFindRecordNo <= intTopValue Then
'code to pass name of picture file to image
'get file name
Application.ScreenUpdating = False
Sheets("CPDB").Visible = xlSheetVisible
Sheets("CPDB").Select 'database worksheet
ActiveSheet.Unprotect
ActiveSheet.Cells(intCellValue, 24).Select
strImgName = ActiveCell.Value
ActiveSheet.Protect
Sheets("CPDB").Visible = xlSheetHidden
'check if file name there
If Len(Trim(strImgName)) > 0 Then
Sheets("View Project").Select
strPath = ActiveWorkbook.Path & "\" & strImgName
imgPath = strPath
Set picPicture = stdole.StdFunctions.LoadPicture( _
imgPath)
Sheets("View Project").Select 'Form worksheet
With ActiveSheet.Image1
.Picture = picPicture
End With
ActiveSheet.Image1.Visible = True
Else
Sheets("View Project").Select
ActiveSheet.Image1.Visible = False
End If
Application.ScreenUpdating = True
End If
Else
ActiveSheet.Image1.Visible = False
End If
End If
Exit Sub
ErrorHandler:
Sheets("View Project").Select
ActiveSheet.Image1.Visible = False
MyMsgbox = MsgBox("The picture file entered for this project " + _
vbCrLf + "does not exist or has been named incorrectly.", , "Project
Image")
End Sub
A worksheet ‘form’ enables the user to view records. Once a record number
is entered into a cell on the form the VLOOKUP function finds the relevant
data to populate the form from another worksheet that contains the database.
One of the fields (cell) on the ‘database’ worksheet contains the file
name of a picture file.
On the ‘form’ worksheet is an ‘Image’ control to show the picture named in
the database.
Once a record number is entered onto the ‘form’ the following code places
the name of the picture file into the picture property of the Image control
and the picture is displayed on the ‘form’ worksheet.
Before the code is run the size of the workbook is approximately 2.5Mb.
After the code is run the size of the workbook increases to approximately
25Mb. The picture file is a .jpg and is less than 1Mb in size.
Why does the file size increase after running code?
How can I prevent the file from increasing so dramatically in size?
Any assistance will be most welcome.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intCellValue As Integer
Dim intTopValue As Integer
Dim strImgName As String
Dim imgPath
Dim strName As String
Dim strPath As String
Dim picPicture As IPictureDisp
If ActiveCell = Cells(5, 3) Then
On Error GoTo ErrorHandler
myActiveCell = ActiveCell.Address
intCellValue = Cells(5, 3).Value 'Record Number
intTopValue = Cells(1, 15).Value 'Last Record Number
varWhat = VarType(intCellValue)
If intCellValue > 0 Then
If intFindRecordNo <= intTopValue Then
'code to pass name of picture file to image
'get file name
Application.ScreenUpdating = False
Sheets("CPDB").Visible = xlSheetVisible
Sheets("CPDB").Select 'database worksheet
ActiveSheet.Unprotect
ActiveSheet.Cells(intCellValue, 24).Select
strImgName = ActiveCell.Value
ActiveSheet.Protect
Sheets("CPDB").Visible = xlSheetHidden
'check if file name there
If Len(Trim(strImgName)) > 0 Then
Sheets("View Project").Select
strPath = ActiveWorkbook.Path & "\" & strImgName
imgPath = strPath
Set picPicture = stdole.StdFunctions.LoadPicture( _
imgPath)
Sheets("View Project").Select 'Form worksheet
With ActiveSheet.Image1
.Picture = picPicture
End With
ActiveSheet.Image1.Visible = True
Else
Sheets("View Project").Select
ActiveSheet.Image1.Visible = False
End If
Application.ScreenUpdating = True
End If
Else
ActiveSheet.Image1.Visible = False
End If
End If
Exit Sub
ErrorHandler:
Sheets("View Project").Select
ActiveSheet.Image1.Visible = False
MyMsgbox = MsgBox("The picture file entered for this project " + _
vbCrLf + "does not exist or has been named incorrectly.", , "Project
Image")
End Sub