NewYorkFashionToGo
Programmer
I have a question about scaling down photo's via VBA Module. I created a module that has this code in it for displaying pictures on a form and all works perfectly well. I just upload the data in a text box. and Picture Dislays. except I would like to make images smaller. It is alot of work to put photos together and I will double my work and space if I have to make thumbnails as well as the picture I want to display on the web. I am using the web display and would like to scale everything down. I can make the box on form smaller but the image is the same size and doesnt display properly. Is there a scale down function in VBA???
The Code in the Module is:
Public Function DisplayImageWeb(ctlBrowserControl As Control, _
strImagePath As Variant)
On Error GoTo Err_DisplayImage
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlBrowserControl
If IsNull(strImagePath) Then
ElseIf Left(strImagePath, 4) = "http" Then
.Navigate (strImagePath)
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Navigate (strImagePath)
End If
End With
Exit_DisplayImage:
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case Else
MsgBox Err.Number & " " & Err.Description
Resume Exit_DisplayImage:
End Select
End Function
And The code In The form Is:
Option Compare Database
Option Explicit
Private Sub Form_AfterUpdate()
CallDisplayImage
End Sub
Private Sub Form_Current()
CallDisplayImage
End Sub
Private Sub Image_3_AfterUpdate()
CallDisplayImage
End Sub
Private Sub CallDisplayImage()
DisplayImageWeb Me.WebBrowser9, Me.Image_3
End Sub
Private Sub WebBrowser9_Updated(Code As Integer)
End Sub
The Code in the Module is:
Public Function DisplayImageWeb(ctlBrowserControl As Control, _
strImagePath As Variant)
On Error GoTo Err_DisplayImage
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlBrowserControl
If IsNull(strImagePath) Then
ElseIf Left(strImagePath, 4) = "http" Then
.Navigate (strImagePath)
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Navigate (strImagePath)
End If
End With
Exit_DisplayImage:
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case Else
MsgBox Err.Number & " " & Err.Description
Resume Exit_DisplayImage:
End Select
End Function
And The code In The form Is:
Option Compare Database
Option Explicit
Private Sub Form_AfterUpdate()
CallDisplayImage
End Sub
Private Sub Form_Current()
CallDisplayImage
End Sub
Private Sub Image_3_AfterUpdate()
CallDisplayImage
End Sub
Private Sub CallDisplayImage()
DisplayImageWeb Me.WebBrowser9, Me.Image_3
End Sub
Private Sub WebBrowser9_Updated(Code As Integer)
End Sub
