এক্সেল Userform দিয়ে ডিজিটাল এড্রেস বুক সফটওয়্যার তৈরি করুন
আমরা আজকের টিউটোরিয়ালে শিখব ইনশাআল্লাহ, মাইক্রোসফ্ট এক্সেল ইউজারফর্ম দিয়ে ছবি সহ ডিজিটাল এড্রেস বুক বানানো।
চলুন শুরু করি এক্সেল এড্রেস তালিকা ইউজারফর্মে রেকর্ডের জন্য ছবি যোগ করার বৈশিষ্ট্য, নিচের ছবিতে ইউজারফর্মের “add Image ” বাটনে ক্লিক করে নির্বাচিত রেকর্ডে পছন্দসই ছবি যোগ করতে পারেন। ছবিটি ইউজারফর্মের ইমেজ কন্ট্রোলে প্রদর্শিত হয়। যখন একটি ছবি যোগ করা হবে তখন ছবির অরিজিনাল ডিমেনশনস msgbox-এ specified হবে।
আমাদের এক্সেল এড্রেস লিষ্টের জন্য ছবি যোগ করার জন্য আমরা যে VBA কোডগুলি ব্যবহার করেছি:
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, ""
MyDirectory = ThisWorkbook.Path
ChDrive Left(MyDirectory, 1)
ChDir MyDirectory
যখন এই বাটনটি ইউজারফর্মে ক্লিক করা হয়, তখন ছবিটি তার আসল আকারে খোলা ইউজারফর্মে প্রদর্শিত হয়। চিত্রের পথটি Userform ফর্মের ক্যাপশন হিসাবে নির্দিষ্ট করা হয়েছে। খোলা ইউজারফর্ম (ছবির আসল আকার) বন্ধ করতে ছবিতে একবার ক্লিক করা যথেষ্ট।
যদি ছবিটি রেফারেন্সযুক্ত ফোল্ডারে না থাকে বা চিত্রের পথটি ভুল হয়, তাহলে প্রোগ্রামটির অপারেশনে ত্রুটিগুলি প্রতিরোধ করতে msgbox এর সাথে একটি সতর্কতা দেওয়া হয়।
আমরা ছবির মূল মাত্রা শিখতে মডিউলে যে ফাংশনটি যোগ করেছি তা ব্যবহার করেছি:
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:WindowsSystem32wiaaut.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📥 Sample file can be downloaded here