ساخت یوزفرم ورود ساعت کارکرد

[lhbb67]

سلام خدمت همه اساتید محترم
من ی یوزرفرم ساختم که بتونم با اون اطلاعات رو وارد کنم اما مشکلی که دارم این است:
1) 15 مورد از اطلاعات باید در ستون b6:b20 باشه و 14 یا 15 یا 16 مورد بعدی در f6:f19 یا f20 یا f21 البته این مورد تا حدودی قابل حله برام
2) مشکل اصلی من اینه که دز فاصله های گفته شده ی سری از سلول ها داری مقداری از قبل هستند یعنی یا جمعه هستند یا تعطیل رسمی من میخوام وقتی داده ها وارد می شوند وقتی به این عبارات رسیدند از روی آنها پرش کرده و در اولین سلول خالی قرار گیرند البته این کار برای یکبار قابل انجام است اما وقتی یکبار این اتفاق افتاد دیگه نمیتونم ردیف های پر رو بشمرم

[lhbb67]

دوستان کسی جوابی نداشت به ما بده حداقل در حد راهنمایی

[iranweld]

فقط برای ستون b مد نظر شماست؟

[lhbb67]

فقط برای ستون b مد نظر شماست؟

خوب نه ممکنه ی سلول دیگه از ستون f هم این اتفاق براش بی افته

[iranweld]

این ماکرو را برای ستون b تست بفرمایید

TextBox2.Value = Format(TextBox2.Value, "HH:MM")
TextBox3.Value = Format(TextBox3.Value, "HH:MM")

For i = 1 To 3
If Sheets(i).Cells(1, 1) = TextBox1 Then
Sheets(i).Activate
End If
Next i

Range("b5").Select
Do
ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell)


ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value


End Sub 

[Ali Parsaei]

سلام،
يه توضيح کلي مي شه بديد که چکار مي خواهيد انجام دهيد؟ شايد کلا" کد ساده تري بتوان نوشت!
ساعات يوزرفرم را برود در شيت مربوطه به ترتيب قرار دهد و از روي جمعه ها و ...هم بپرد؟ ساعت شروع هم براي همه شيتها ثابت در خانه b5 نوشته شده؟

[lhbb67]

این ماکرو را برای ستون b تست بفرمایید

TextBox2.Value = Format(TextBox2.Value, "HH:MM")
TextBox3.Value = Format(TextBox3.Value, "HH:MM")

For i = 1 To 3
If Sheets(i).Cells(1, 1) = TextBox1 Then
Sheets(i).Activate
End If
Next i

Range("b5").Select
Do
ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell)


ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value


End Sub 

مرسی از لطف شما برای این ستون کاملا اکی بود و من این رو به این شکل اصلاح کردم تا برای ستون ب هم به من جواب بده

Private Sub CommandButton1_Click()Dim x As Integer

TextBox2.Value = Format(TextBox2.Value, "HH:MM")TextBox3.Value = Format(TextBox3.Value, "HH:MM")
For i = 1 To 3If Sheets(i).Cells(1, 1) = TextBox1 ThenSheets(i).ActivateEnd IfNext iIf WorksheetFunction.CountA(Range("b5:b20")) < 16 ThenRange("b5").SelectDoActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

ActiveCell.Value = TextBox2.ValueActiveCell.Offset(0, 1).Value = TextBox3.ValueElseIf WorksheetFunction.CountA(Range("b5:b20")) = 16 ThenRange("f5").SelectDoActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

ActiveCell.Value = TextBox2.ValueActiveCell.Offset(0, 1).Value = TextBox3.ValueEnd If
End Sub 

اما الان ی مشکلی هست ببینید 15 روز از ماه در ستون b و 14 یا 15 یا 16 روز بسته به ماه در ستون f قرار میگیره حالا چطور میشه ی شرطتوقف براش قائل شد. یعنی اگر ماه اسفند بود و 29 روز تا ردیف 19 بیشتر پر نشه اگر فروردین بود تا ردیف 21 و ...

[lhbb67]

Private Sub CommandButton1_Click()
Dim x As Integer




TextBox2.Value = Format(TextBox2.Value, "HH:MM")
TextBox3.Value = Format(TextBox3.Value, "HH:MM")


For i = 1 To 3
If Sheets(i).Cells(1, 1) = TextBox1 Then
Sheets(i).Activate
End If
Next i
If WorksheetFunction.CountA(Range("b5:b20")) < 16 Then
Range("b5").Select
Do
ActiveCell.Offset(1, 0).Select


Loop Until IsEmpty(ActiveCell)




ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value
ElseIf WorksheetFunction.CountA(Range("b5:b20")) = 16 Then
Range("f5").Select
Do
ActiveCell.Offset(1, 0).Select


Loop Until IsEmpty(ActiveCell)




ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value
End If


End Sub

[lhbb67]

من اینطوری اصلاح کردم اگر به نظرتون خوبه همین رو استفاده کنم من کار با دستور آفست رو بلد نیستم و نبودم اما این دستور خیلی کار رو راحت کرد

[iranweld]

با سلام

بایستی به فایل خود ماژول تاریخ شمسی را اضافه کنید یا یک کمبو باکس برای مشخص کردن ماه ایجاد کنید و بوسیله آن عدد ماه جاری را بدست آورید و سپس با دستور select case برای ماه هایی که دیتای آن فرق میکند دستورات جداگانه بنویسید

در فایل پیوست ماژول تاریخ شمسی و دستور بدست آوردن عدد ماه جاری و دستور select case اضافه گردیده است

دستورات لازم برای ماه هایی که تفاوت دارند را در بین select case اضافه کنید(برای select case یک و دوازده و select else برای سایر ماههای مشابه)
در صورت نیاز برای تعریف یک ماه دیگر میتوانید یک آیتم مثلا برای تیرماه Case Is = 4 اضافه کنید

Private Sub CommandButton1_Click()

Dim x As Integer
Dim xx As Integer

xx = Mid(J_TODAY(), 4, 2)

TextBox2.Value = Format(TextBox2.Value, "HH:MM")

TextBox3.Value = Format(TextBox3.Value, "HH:MM")

For i = 1 To 3
If Sheets(i).Cells(1, 1) = TextBox1 Then
Sheets(i).Activate
End If
Next i

Select Case xx


    Case Is = 1
    
    
        Result = "very good"
        
    Case Is = 12
    
    
    
        Result = "good"
    
    Case Else
    
    
    
        Result = "insufficient"
        
End Select


MsgBox Result


End Sub 

[iranweld]

برای تایپ عدد ساعت و درج ":" بصورت خودکار کدهای ذیل را به ماکرو اضافه کنید

Private Sub TextBox2_Change()
If Len(TextBox2.Value) = 4 And IsNumeric(TextBox2.Value) Then
TextBox2.Value = Left(TextBox2.Value, 2) & ":" & Right(TextBox2.Value, 2)
End If
End Sub

Private Sub TextBox3_Change()
If Len(TextBox3.Value) = 4 And IsNumeric(TextBox3.Value) Then
TextBox3.Value = Left(TextBox3.Value, 2) & ":" & Right(TextBox3.Value, 2)
End If
End Sub 

[lhbb67]

خیلی مفید بود فقط من پست قبلی(پاسخ شماره 10) رو متوجه نشدم الان من دسترسی به فایل اصلی ندارم من تغییراتم رو اعمال میکنم فایل اصلی رو قرار میدم لطفا اونجا بهم کمک کنید
و البته من از پاسخ شماره 11 شما خیلی چیز یاد گرفتم وقعا ممنونم ازتون

[lhbb67]

دوستان این فایلیه که ساختم لطفا بررسی بفرمایید البته ردپای دوستان هم توش هست

[lhbb67]

از اساتید کسی می تونه کد های دکمه تعطیلات رو اصلاح کنه فکر میکنم خیلی الکی زیاد هستن من جواب صحیح رو میگیرم ازش ولی حس میکنم لقمه رو دور سرم چرخوندم

[iranweld]

با سلام

در هنگام ثبت تاریخ ماهانه بصورت اتوماتیک روزهای جمعه و تعطیل در ستونهای مجاور درج میگردد(روزهای جمعه اتوماتیک شناسایی شده و تعطیلات رسمی از شیت تعطیلات فراخوانی میگردد)