Excel Address Book With Image
In some cases, the user may want to add the desired image to the selected record by clicking the “Add Image” button on the userform. For this purpose, we prepared a userform where images are displayed. In this userform ,the image is displayed in the Image control on the userform. When an image is added, the original dimensions of the image are specified in a msgbox.
The VBA codes we use to add images for our Excel address list: ↓
Dim ara As Range, dosya As Variant Dim MyDirectory As String MyDirectory = ThisWorkbook.Path If TextBox1 = "" And TextBox3 = "" Then MsgBox "Not Any Item Selected", vbCritical, "" Exit Sub Else ChDrive Left(MyDirectory, 1) ChDir MyDirectory dosya=Application.GetOpenFilename(FileFilter:="," & "*.jpg;*.gif;*.jpeg;*.bmp;*.GIF;*.JPG;*.tiff;*.tif", _ Title:="Please Choose An Image") If dosya = False Then MsgBox "Image Not Selected", vbCritical Exit Sub Else Image2.Picture = LoadPicture("") Set ara = Sheets("liste").Range("B:B").Find(ListBox1, , xlValues, xlWhole) If Not ara Is Nothing Then Sheets("liste").Cells(ara.Row, 14).Value = yol & dosya & uzanti Image2.Picture = LoadPicture(yol & dosya & uzanti) TextBox15 = Sheets("liste").Cells(ara.Row, 14).Value If Not (TextBox15 = Empty) Then resimgen = GetImageSize(TextBox15)(0) resimyuks = GetImageSize(TextBox15)(1) End If If resimgen > Image2.Width Or resimyuks > Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeStretch Image2.Picture = LoadPicture(TextBox15) End If If resimgen <= Image2.Width Or resimyuks <= Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeClip Image2.Picture = LoadPicture(TextBox15) End If End If End If End If MsgBox "The picture you selected has been successfully added." & vbCrLf & "" & vbCrLf & - "Original dimensions of the image that you added:" & vbCrLf & "Width:" & " " & resimgen & - "px" & vbCrLf & "Height:" & " " & resimyuks & "px", vbInformation, ""MyDirectory = ThisWorkbook.Path If TextBox1 = "" And TextBox3 = "" Then MsgBox "Not Any Item Selected", vbCritical, "" Exit Sub Else ChDrive Left(MyDirectory, 1) ChDir MyDirectory dosya=Application.GetOpenFilename(FileFilter:="," & "*.jpg;*.gif;*.jpeg;*.bmp;*.GIF;*.JPG;*.tiff;*.tif", _ Title:="Please Choose An Image") If dosya = False Then MsgBox "Image Not Selected", vbCritical Exit Sub Else Image2.Picture = LoadPicture("") Set ara = Sheets("liste").Range("B:B").Find(ListBox1, , xlValues, xlWhole) If Not ara Is Nothing Then Sheets("liste").Cells(ara.Row, 14).Value = yol & dosya & uzanti Image2.Picture = LoadPicture(yol & dosya & uzanti) TextBox15 = Sheets("liste").Cells(ara.Row, 14).Value If Not (TextBox15 = Empty) Then resimgen = GetPictureSize(TextBox15)(0) resimyuks = GetPictureSize(TextBox15)(1) End If If resimgen > Image2.Width Or resimyuks > Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeStretch Image2.Picture = LoadPicture(TextBox15) End If If resimgen <= Image2.Width Or resimyuks <= Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeClip Image2.Picture = LoadPicture(TextBox15) End If End If End If End If
MsgBox "The picture you selected has been successfully added." & vbCrLf & "" & vbCrLf & -
"Original dimensions of the image that you added:" & vbCrLf & "Width:" & " " & resimgen & -
"px" & vbCrLf & "Height:" & " " & resimyuks & "px", vbInformation, ""
Dim ara As Range, dosya As Variant Dim MyDirectory As String MyDirectory = ThisWorkbook.Path If TextBox1 = "" And TextBox3 = "" Then MsgBox "Not Any Item Selected", vbCritical, "" Exit Sub Else ChDrive Left(MyDirectory, 1) ChDir MyDirectory dosya=Application.GetOpenFilename(FileFilter:="," & "*.jpg;*.gif;*.jpeg;*.bmp;*.GIF;*.JPG;*.tiff;*.tif", _ Title:="Please Choose An Image") If dosya = False Then MsgBox "Image Not Selected", vbCritical Exit Sub Else Image2.Picture = LoadPicture("") Set ara = Sheets("liste").Range("B:B").Find(ListBox1, , xlValues, xlWhole) If Not ara Is Nothing Then Sheets("liste").Cells(ara.Row, 14).Value = yol & dosya & uzanti Image2.Picture = LoadPicture(yol & dosya & uzanti) TextBox15 = Sheets("liste").Cells(ara.Row, 14).Value If Not (TextBox15 = Empty) Then resimgen = GetImageSize(TextBox15)(0) resimyuks = GetImageSize(TextBox15)(1) End If If resimgen > Image2.Width Or resimyuks > Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeStretch Image2.Picture = LoadPicture(TextBox15) End If If resimgen <= Image2.Width Or resimyuks <= Image2.Height Then Image2.PictureSizeMode = fmPictureSizeModeClip Image2.Picture = LoadPicture(TextBox15) End If End If End If End If MsgBox "The picture you selected has been successfully added." & vbCrLf & "" & vbCrLf & - "Original dimensions of the image that you added:" & vbCrLf & "Width:" & " " & resimgen & -
"px" & vbCrLf & "Height:" & " " & resimyuks & "px", vbInformation, ""↑ As seen in the above VBA codes ; for convenience, we have assigned the image path to a hidden textbox(TextBox15) on the userform. We used this textbox (TextBox15) to upload images to the image control (Image2) on the userform. ⤶ Image2.Picture = LoadPicture(TextBox15)
MyDirectory = ThisWorkbook.Path
ChDrive Left(MyDirectory, 1)
ChDir MyDirectory → With these codes in the procedure, the workbook’s folder is opened by default folder for the image upload folder. If user want, can choose another folder to add image. I recommend that the pictures you add with the workbook are in the same folder. Thus, when you change the location of the folder or move the template to another PC, you will not have a problem viewing images.The path of the picture is added to column N of the record selected in the worksheet.
ChDrive Left(MyDirectory, 1)
ChDir MyDirectory → With these codes in the procedure, the workbook’s folder is opened by default folder for the image upload folder. If user want, can choose another folder to add image. I recommend that the pictures you add with the workbook are in the same folder. Thus, when you change the location of the folder or move the template to another PC, you will not have a problem viewing images.The path of the picture is added to column N of the record selected in the worksheet.
When this button is clicked on the userform, the picture is displayed in a newly opened userform in its original size. The image’s path is specified as the caption of the userform. It is enough to click once on the picture to close the opened userform (the original size of the picture).
If the image is not in the referenced folder or the image path is wrong, a warning is given with msgbox to prevent errors in the operation of the program.
We used the following function that we added to the module to learn the original dimensions of the picture : ↓
Function GetPictureSize(ImagePath As String) As Variant 'Returns an array of integers that hold the image width and height in pixels. 'The first element of the array corresponds to the width and the second to the height. 'The function uses the Microsoft Windows Image Acquisition Library v2.0, which can be 'found in the path: C:\Windows\System32\wiaaut.dll 'However, the code is written in late binding, so no reference is required. Dim imgSize(1) As Integer Dim res As Object 'Check that the image file exists. If FileExists(ImagePath) = False Then Exit Function 'Check that the image file corresponds to an image format. If IsValidImageFormat(ImagePath) = False Then Exit Function 'Create the ImageFile object and check if it exists. On Error Resume Next Set res = CreateObject("WIA.ImageFile") If res Is Nothing Then Exit Function On Error GoTo 0 'Load the ImageFile object with the specified File. res.LoadFile ImagePath 'Get the necessary properties. imgSize(0) = res.Width imgSize(1) = res.Height 'Release the ImageFile object. Set res = Nothing 'Return the array. GetPictureSize = imgSize End Function Function FileExists(FilePath As String) As Boolean On Error Resume Next If Len(FilePath) > 0 Then If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True End If On Error GoTo 0 End Function Function IsValidImageFormat(FilePath As String) As Boolean '---------------------------------------------- 'Checks if a given path is a valid image file. '---------------------------------------------- Dim imageFormats As Variant Dim i As Integer 'Some common image extentions. imageFormats = Array(".bmp", ".jpg", ".gif", ".tif") 'Loop through all the extentions and check if the path contains one of them. For i = LBound(imageFormats) To UBound(imageFormats) 'If the file path contains the extension return true. If InStr(1, UCase(FilePath), UCase(imageFormats(i)), vbTextCompare) > 0 Then IsValidImageFormat = True Exit Function End If Next i End Function
No comments:
Post a Comment