এক্সেল ইউজারফর্মের মাধ্যমে cell-এ তারিখ যোগ করুন খুব সহজেই -Add date to cell easily with Excel Userform

এক্সেল cell-এ তারিখ যোগ করুন খুব সহজেই ইউজারফর্মের মাধ্যমে - Add date in excel cell easily with Userform

সক্রিয় cell-এ  তারিখ যোগ এবং পরিবর্তন করার জন্য আমরা একটি ছোট  ইউজারফর্ম তৈরি করেছি। আমাদের ইউজারফর্ম হল ডেট পিকারের একটি দরকারী বিকল্প যার কোনো .ocx ফাইলের প্রয়োজন নেই৷ নির্বাচিত কলামের ঘরগুলিতে ডাবল-ক্লিক করার মাধ্যমে, তারিখ ইউজারফর্ম খোলে এবং যখন মাসের প্রতিটি দিনের জন্য তৈরি করা বাটনগুলির মধ্যে একটি ক্লিক করা হয়, তখন তারিখটি ঘরে যোগ হয়ে যাবে। 

তারিখ ফর্ম ব্যবহার করে কোন শীটে তারিখ যোগ করতে চাইলে, সেই শীটের Worksheet_BeforeDoubleClick পদ্ধতিতে প্রয়োজনীয় VBA কোড যোগ করতে হবে। আমাদের উদাহরণ টেমপ্লেটে, আমরা সিদ্ধান্ত নিয়েছি যে কলাম B-এর ঘর 1 ব্যতীত যেকোনো ঘরে ডাবল ক্লিক করে ইউজারফর্ম প্রদর্শন করা উপযুক্ত। এই উদ্দেশ্যে, আমরা নিম্নলিখিত কোডগুলি যুক্ত করেছি: এক্সেল তারিখ ইউজারফর্মে।: 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sectin As Variant
If Target.Column = 2 And Target.Row > 1 Then
...
Call DisplayUserForm
End If

আমরা নির্দিষ্ট করেছি যে আমরা কোডগুলির Target.Column = 2 সেকশন কোড , কিন্তু Target.Row > 1 কোড স্নিপেট দিয়ে আমরা নিশ্চিত করেছি যে B1 (1st cell) এই অপারেশন থেকে বাদ দেওয়া হবে।

তারিখ ব্যবহারকারীর ফর্মে দিন এবং মাসের নামগুলি ব্যবহারকারীর সিস্টেম ভাষা অনুসারে তৈরি করা হয়৷ আমরা লেবেল নিয়ন্ত্রণগুলিতে দিনের নামগুলি বরাদ্দ করার জন্য Userform_Initialize পদ্ধতিতে একটি ফর-নেক্সট লুপ যুক্ত করেছি: এক্সেল লেবেলে ম্যাক্রো অ্যাসাইন করুন  

 

Private Sub UserForm_Initialize()
Dim m, n As Byte
n = 1
For m = 2 To 8
Me.Controls("label" & m).Caption = WeekdayName(n, True, 2)
n = n + 1
Next
...
End Sub

আমরা মাসের নাম ড্রপডাউন তালিকার জন্য নিম্নলিখিত লুপ  যোগ করেছি: এক্সেল আইটেম কম্বোবক্সে যোগ করুন : 

For i = 1 To 12
ComboBox1.AddItem MonthName(i, 0)
Next i

ইউজারফর্মের অপশন বাটন নিয়ন্ত্রণের সাথে তারিখ বিন্যাস নির্বাচন করা যেতে পারে। এক্সেল তারিখ বিন্যাস mm.dd.yyyy  বা or mm.dd.yyyy  সিলেক্ট করুন।

আজকের তারিখ এবং উইকএন্ড ইউজারফর্মে বিভিন্ন রঙে নির্দেশিত হয়। উইকএন্ডের রঙ পরিবর্তনের জন্য, আমরা প্রথমে ইউজারফর্ম কোডের শীর্ষে 

Const weekend_different_color As Boolean = True

কোড যোগ করুন। আমরা নামের  একটি পদ্ধতি তৈরি করেছি 

date_setting()

যেটি দিনের সংখ্যা অনুসারে ইউজারফর্মের আকার সেট করতে এবং ইউজারফর্মে রঙ পরিবর্তন সেট করতে সাহায্য করবে। এই পদ্ধতিতে আমরা উইকএন্ডের রঙগুলি নিম্নলিখিত কোডগুলি সেট করি;

If weekend_different_color = True And left> = 95 Then
.BackColor = 9434879
End If

আজকের তারিখকে ভিন্ন রঙে নির্দেশ করতে :

If yil = Year(Now) And ay = Month(Now) Then
Frame1.Controls(Day(Now) - 1).BackColor = 55295
End If

Date Add  ইউজারফর্মের আরেকটি গুরুত্বপূর্ণ বৈশিষ্ট্য হল; নির্বাচিত এবং ক্লিক করা ঘরে একটি তারিখ থাকলে, দিন, মাস এবং বছর সেই তারিখ অনুসারে সামঞ্জস্য করা হয় এবং এটি ব্যবহারকারীর জন্য ব্যবহারকারীর ফর্মে প্রদর্শিত হয়।

এছাড়াও, ঘরে তারিখের বিন্যাস অপশন বাটনগুলির সাথে নির্দেশিত হয়। ব্যবহারকারী যদি ওয়ার্কবুকের সমস্ত শীটের কলাম B-এ userform-এর সাথে তারিখ যোগ করতে চান, তাহলে তাদের VBA উইন্ডোতে ওয়ার্কবুকে নিম্নলিখিত কোডগুলি যোগ করা উচিত (ওয়ার্কবুকে VBA কোড যোগ করার পর, ওয়ার্কশীটের কোডগুলি সরানো যেতে পারে।) : excel add ওয়ার্কবুক 

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim sectin As Variant
If Target.Column = 2 And Target.Row > 1 Then
        Cancel = True
        tarih = Empty
        sectin = Split(Target, ".")
        If UBound(sectin) = 2 Then
            On Error Resume Next
            tarih = DateSerial(sectin(2), sectin(1), sectin(0))
            On Error GoTo 0
        End If
        Call DisplayUserForm
End If
End Sub

 ইউজারফর্ম খুলতে পরবর্তী একটিভ cell , আমরা নিম্নলিখিত কোডগুলি লিখুন ভিতর  Module1 : 

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 = date_Form
    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

 

Message karimExcelVba.com on WhatsApp. https://wa.me/message/WBBB44WMNKD2C1