এক্সেল cell তারিখ যোগ করুন Userform দিয়ে

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

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

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

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

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

আপনাদের কোডিং এর সমস্যা বা বুঝতে সমস্যা কমেন্ট করুন।  ধন্যবাদ

আমাদের সম্পর্কে জানতে এবং বিভিন্ন টিউটোরিয়াল পেতে লাইক ও সাবস্ক্রাইব করে সাথেই থাকুন