এক্সেল ক্যালেন্ডার ইউজারফর্ম দিয়ে Cell তারিখ যোগ করুন:Excel vba
এক্সেল ক্যালেন্ডার ইউজারফর্ম দিয়ে Cell তারিখ যোগ করতে শিখুন। এটি আপনাকে এক্সেলের উপরে আপনার ব্যবহারকারীর ইনপুটের ভিত্তিতে সঠিক তারিখ যোগ করতে সাহায্য করবে।
এই গাইডে আপনি শিখবেন কিভাবে ডাবল ক্লিক করে এক্সেলে কোন সেলে তারিখ যোগ করতে পারেন। এটি আপনার কাজটি সহজ ও দ্রুত করার উপায়।
ওয়ার্কশীটের যেকোনো cell-এ ডাবল ক্লিক করে “ক্যালেন্ডার ইউজারফর্ম” এর মাধ্যমে তারিখ যোগ এবং পরিবর্তন করতে পারবেন। ওয়ার্কশীটের যেকোনো cell-এ তারিখ যোগ এবং পরিবর্তন করার জন্য আমরা একটি ছোট ইউজারফর্ম তৈরি করেছি। আমাদের ইউজারফর্ম হল ডেট পিকারের একটি দরকারী বিকল্প যার কোনো .ocx ফাইলের প্রয়োজন নেই৷ যখন নির্বাচিত কলামের সেলগুলিতে ডাবল-ক্লিক করার মাধ্যমে, ইউজারফর্ম খোলে বছর, মাস এবং দিনের জন্য তৈরি করা যে বাটন উপর ক্লিক করলে, তখন তারিখটি সেলে যোগ হয়ে যাবে।
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call DisplayUserForm
End Sub
একটি ইউজারফর্ম বানান:
'For more : https://karimvba.blogspot.com/
Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMth As Date
Dim CreateCal As Boolean
Dim i As Integer
Private Sub CB_Mth_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.CB_Mth.DropDown
End Sub
Private Sub CB_Yr_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.CB_Yr.DropDown
End Sub
Private Sub Userform_Activate()
Call SystemButtonSettings(Me, False)
End Sub
Private Sub UserForm_Initialize()
Call SystemButtonSettings(Me, False)
Application.EnableEvents = False
‘starts the form on todays date
ThisDay = Date
ThisMth = VBA.Format(ThisDay, “mm”)
ThisYear = VBA.Format(ThisDay, “yyyy”)
For i = 1 To 12
CB_Mth.AddItem VBA.Format(DateSerial(Year(Date), Month(Date) + i, 0), “mmmm”)
Next
CB_Mth.ListIndex = VBA.Format(Date, “mm”) – VBA.Format(Date, “mm”)
For i = -20 To 50
If i = 1 Then CB_Yr.AddItem VBA.Format((ThisDay), “yyyy”) Else CB_Yr.AddItem _
VBA.Format((DateAdd(“yyyy”, (i – 1), ThisDay)), “yyyy”)
Next
CB_Yr.ListIndex = 21
‘Builds the calendar with todays date
CalendarForm.Width = CalendarForm.Width
CreateCal = True
Call Create_Calendar
Application.EnableEvents = True
End Sub
Private Sub CB_Mth_Change()
Call Create_Calendar
End Sub
Private Sub CB_Yr_Change()
Call Create_Calendar
End Sub
Private Sub Create_Calendar()
If CreateCal = True Then
CalendarForm.Caption = ” ” & CB_Mth.Value & ” ” & CB_Yr.Value
‘sets the focus for the todays date button
CommandButton1.SetFocus
For i = 1 To 42
If i < Weekday((CB_Mth.Value) & “/1/” & (CB_Yr.Value)) Then
Controls(“D” & (i)).Caption = VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) & “/1/” _
& (CB_Yr.Value))), ((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “d”)
Controls(“D” & (i)).ControlTipText = VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) _
& “/1/” & (CB_Yr.Value))), ((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “mm/dd/yyyy”)
ElseIf i >= Weekday((CB_Mth.Value) & “/1/” & (CB_Yr.Value)) Then
Controls(“D” & (i)).Caption = VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) _
& “/1/” & (CB_Yr.Value))), ((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “d”)
Controls(“D” & (i)).ControlTipText = VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) _
& “/1/” & (CB_Yr.Value))), ((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “mm/dd/yyyy”)
End If
If VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), _
((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “mmmm”) = ((CB_Mth.Value)) Then
Controls(“D” & (i)).Font.Bold = True
If VBA.Format(DateAdd(“d”, (i – Weekday((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), _
((CB_Mth.Value) & “/1/” & (CB_Yr.Value))), “mm/dd/yyyy”) = VBA.Format(ThisDay, “mm/dd/yyyy”) _
Then Controls(“D” & (i)).SetFocus
Else
Controls(“D” & (i)).Font.Bold = False
End If
Next
End If
End Sub
Private Sub D1_Click()
ActiveCell.Value = D1.ControlTipText
Unload Me
End Sub
Private Sub D2_Click()
ActiveCell.Value = D2.ControlTipText
Unload Me
End Sub
Private Sub D3_Click()
ActiveCell.Value = D3.ControlTipText
Unload Me
End Sub
Private Sub D4_Click()
ActiveCell.Value = D4.ControlTipText
Unload Me
End Sub
Private Sub D5_Click()
ActiveCell.Value = D5.ControlTipText
Unload Me
End Sub
Private Sub D6_Click()
ActiveCell.Value = D6.ControlTipText
Unload Me
End Sub
Private Sub D7_Click()
ActiveCell.Value = D7.ControlTipText
Unload Me
End Sub
Private Sub D8_Click()
ActiveCell.Value = D8.ControlTipText
Unload Me
End Sub
Private Sub D9_Click()
ActiveCell.Value = D9.ControlTipText
Unload Me
End Sub
Private Sub D10_Click()
ActiveCell.Value = D10.ControlTipText
Unload Me
End Sub
Private Sub D11_Click()
ActiveCell.Value = D11.ControlTipText
Unload Me
End Sub
Private Sub D12_Click()
ActiveCell.Value = D12.ControlTipText
Unload Me
End Sub
Private Sub D13_Click()
ActiveCell.Value = D13.ControlTipText
Unload Me
End Sub
Private Sub D14_Click()
ActiveCell.Value = D14.ControlTipText
Unload Me
End Sub
Private Sub D15_Click()
ActiveCell.Value = D15.ControlTipText
Unload Me
End Sub
Private Sub D16_Click()
ActiveCell.Value = D16.ControlTipText
Unload Me
End Sub
Private Sub D17_Click()
ActiveCell.Value = D17.ControlTipText
Unload Me
End Sub
Private Sub D18_Click()
ActiveCell.Value = D18.ControlTipText
Unload Me
End Sub
Private Sub D19_Click()
ActiveCell.Value = D19.ControlTipText
Unload Me
End Sub
Private Sub D20_Click()
ActiveCell.Value = D20.ControlTipText
Unload Me
End Sub
Private Sub D21_Click()
ActiveCell.Value = D21.ControlTipText
Unload Me
End Sub
Private Sub D22_Click()
ActiveCell.Value = D22.ControlTipText
Unload Me
End Sub
Private Sub D23_Click()
ActiveCell.Value = D23.ControlTipText
Unload Me
End Sub
Private Sub D24_Click()
ActiveCell.Value = D24.ControlTipText
Unload Me
End Sub
Private Sub D25_Click()
ActiveCell.Value = D25.ControlTipText
Unload Me
End Sub
Private Sub D26_Click()
ActiveCell.Value = D26.ControlTipText
Unload Me
End Sub
Private Sub D27_Click()
ActiveCell.Value = D27.ControlTipText
Unload Me
End Sub
Private Sub D28_Click()
ActiveCell.Value = D28.ControlTipText
Unload Me
End Sub
Private Sub D29_Click()
ActiveCell.Value = D29.ControlTipText
Unload Me
End Sub
Private Sub D30_Click()
ActiveCell.Value = D30.ControlTipText
Unload Me
End Sub
Private Sub D31_Click()
ActiveCell.Value = D31.ControlTipText
Unload Me
End Sub
Private Sub D32_Click()
ActiveCell.Value = D32.ControlTipText
Unload Me
End Sub
Private Sub D33_Click()
ActiveCell.Value = D33.ControlTipText
Unload Me
End Sub
Private Sub D34_Click()
ActiveCell.Value = D34.ControlTipText
Unload Me
End Sub
Private Sub D35_Click()
ActiveCell.Value = D35.ControlTipText
Unload Me
End Sub
Private Sub D36_Click()
ActiveCell.Value = D36.ControlTipText
Unload Me
End Sub
Private Sub D37_Click()
ActiveCell.Value = D37.ControlTipText
Unload Me
End Sub
Private Sub D38_Click()
ActiveCell.Value = D38.ControlTipText
Unload Me
End Sub
Private Sub D39_Click()
ActiveCell.Value = D39.ControlTipText
Unload Me
End Sub
Private Sub D40_Click()
ActiveCell.Value = D40.ControlTipText
Unload Me
End Sub
Private Sub D41_Click()
ActiveCell.Value = D41.ControlTipText
Unload Me
End Sub
Private Sub D42_Click()
ActiveCell.Value = D42.ControlTipText
Unload Me
End Sub
'For more : https://karimexcelvba.blogspot.com/
Type POINTAPI
X As Long
Y As Long
End Type
#If VBA7 Then
Declare PtrSafe Function GetDeviceCaps Lib “gdi32” (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDC Lib “user32” (ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib “user32” (ByVal hWnd As LongPtr, ByVal hDc As LongPtr) As Long
Dim hDc As LongPtr
#Else
Declare Function GetDeviceCaps Lib “gdi32” (ByVal hDc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib “user32” (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib “user32” (ByVal hWnd As Long, ByVal hDc As Long) As Long
Dim hDc As Long
#End If
Sub DisplayUserForm()
Dim objCell As Range
Dim objUserForm As Object
Set objCell = ActiveCell
Set objUserForm = CalendarForm
PositionForm objUserForm, objCell
objUserForm.show
End Sub
Sub PositionForm(ByVal objUserForm As Object, ByVal objPosCell As Range)
With objUserForm
.startupposition = 0
.Left = TopLeftPoint(objPosCell).X + objPosCell.Width
.Top = TopLeftPoint(objPosCell).Y
End With
End Sub
Function TopLeftPoint(ByVal Alan As Range) As POINTAPI
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Const PointsPerInch = 72
Dim PixelsPerPointX As Double
Dim PixelsPerPointY As Double
Dim PointsPerPixelX As Double
Dim PointsPerPixelY As Double
hDc = GetDC(0)
PixelsPerPointX = GetDeviceCaps(hDc, LOGPIXELSX) / PointsPerInch
PointsPerPixelX = PointsPerInch / GetDeviceCaps(hDc, LOGPIXELSX)
PixelsPerPointY = GetDeviceCaps(hDc, LOGPIXELSY) / PointsPerInch
PointsPerPixelY = PointsPerInch / GetDeviceCaps(hDc, LOGPIXELSY)
With TopLeftPoint
.X = ActiveWindow.PointsToScreenPixelsX(Alan.Left * _
(PixelsPerPointX * (ActiveWindow.Zoom / 100))) * PointsPerPixelX
.Y = ActiveWindow.PointsToScreenPixelsY(Alan.Top * _
(PixelsPerPointY * (ActiveWindow.Zoom / 100))) * PointsPerPixelY
End With
ReleaseDC 0, hDc
End Function
আমাদের সম্পর্কে জানতে এবং বিভিন্ন টিউটোরিয়াল পেতে লাইক ও সাবস্ক্রাইব করে সাথেই থাকুন
https://youtube.com/@KarimExcelVba
https://www.instagram.com/karimexcelvba/
https://twitter.com/KarimExcelVBA
https://www.linkedin.com/in/karimexcel/
https://www.quora.com/profile/KarimExcelVBA
https://www.reddit.com/user/KarimExcelVBA
https://www.tumblr.com/karimexcelvba
https://www.flickr.com/photos/karimexcelvba/
https://www.pinterest.com/KarimExcelVBA/