בירור | אקסל עזרה פשוטה

[פלורידה]

מורכב מאוד אך אני אנסה להסביר.

1. אתה צריך לבחור את הטור הטור הרלוונטי ולעצב אותו כטבלה.

2. אתה צריך להיכנס לויזואל בייסיק. (מפתחים > Visoal Basic)

3.בצד שמאל יש לך "גליון 1" (בתמונה מס' 1) "חוברת עבודה" (בתמונה מס' 2). אתה תלחץ עליהם, אתה תפתח דף (בתמונה מס' 3).

4. תלחץ פעמיים על ה"גליון זה" ותכניס שם את הקוד הזה

' שני לחיצות על השדות הרלוונטיים מוסיפות לתא את התאריך, שתי לחיצות נוספות יבטלו זאת
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo ErrorHandler
           If Target.ListObject Is Nothing Then Exit Sub
         If Not Intersect(Target, Range(Target.ListObject.Name & "[[עמודה1]:[עמודה1]]")) Is Nothing Then
           Application.EnableEvents = False
                If ActiveCell.Value = Date Then
                    ActiveCell.ClearContents
                    ActiveCell.Validation.Delete
                    'Selection.Validation.Delete
                 Else
                     ActiveCell.Value = Date
                     ActiveCell.Select
                   Application.Run "Unprotect_WorkSheet_With_Password"
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = hebrewdate(Date)
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
     End With
           End If
             Cancel = True
           End If
          Application.EnableEvents = True
          Application.Run "protect_WorkSheet_With_Password"
ErrorHandler:
Application.EnableEvents = True
Application.Run "protect_WorkSheet_With_Password"
      Exit Sub
End Sub

זה ייראה ככה:

5. תלחץ מקש ימני על החלונית השמאלית. ותפתח מודול (כמו בתמונה)
   

6. תעתיק לתוכו את הקוד הזה.

Public Sub enable_event()
 Application.EnableEvents = True
End Sub
Function hebrewdate(thedate)

Dim hebdate As String
Dim hebday As Integer, hebdaylet As String
Dim hebyear As Integer, hebyearlet As String

hebdate = Excel.WorksheetFunction.Text(thedate, "[$-8040D]ddmmmyyyy")

hebday = Mid(hebdate, 1, 2) * 1

hebdaylet = hebdayconv(hebday)

hebyear = Mid(hebdate, Len(hebdate) - 3, 4) * 1

hebyearlet = hebyearconv(hebyear)

hebrewdate = hebdaylet & " " & Chr(225) & Mid(hebdate, 3, Len(hebdate) - 6) & " " & hebyearlet

End Function



Private Function hebdayconv(hebday As Integer)
Dim un As Integer, dec As Integer
Dim unletter As String, decletter As String

decletter = ""

'un = (hebday / 10 - Excel.WorksheetFunction.RoundDown(hebday / 10, 0)) * 10
'Select Case hebday
'Case hebday = 19
'        decletter = Chr(233 + dec)
'
'    Case Is > 9
'        decletter = Chr(233)
'End Select

Select Case hebday
   Case 1
        decletter = "א"
   Case 2
        decletter = "ב"
   Case 3
        decletter = "ג"
   Case 4
        decletter = "ד"
   Case 5
        decletter = "ה"
   Case 6
        decletter = "ו"
   Case 7
        decletter = "ז"
   Case 8
        decletter = "ח"
   Case 9
        decletter = "ט"
   Case 10
        decletter = "י"
   Case 11
        decletter = "יא"
   Case 12
        decletter = "יב"
   Case 13
        decletter = "יג"
   Case 14
        decletter = "יד"
   Case 15
        decletter = "טו"
   Case 16
        decletter = "טז"
   Case 17
        decletter = "יז"
   Case 18
        decletter = "יח"
   Case 19
        decletter = "יט"
   Case 20
        decletter = "כ"
   Case 21
        decletter = "כא"
   Case 22
        decletter = "כב"
   Case 23
        decletter = "כג"
   Case 24
        decletter = "כד"
   Case 25
        decletter = "כה"
   Case 26
        decletter = "כו"
   Case 27
        decletter = "כז"
   Case 28
        decletter = "כח"
   Case 29
        decletter = "כט"
   Case 30
        decletter = "ל"
        
              
End Select


hebdayconv = decletter & unletter & "'"

End Function



Private Function hebyearconv(hebyear)
Dim un As Integer, dec As Integer
Dim unletter As String, decletter As String

un = (hebyear / 10 - Excel.WorksheetFunction.RoundDown(hebyear / 10, 0)) * 10

If un = 0 Then
    unletter = ""
Else
    unletter = Chr(223 + un)
End If

dec = (hebyear - 5700 - un) / 10

Select Case dec
    Case 1
        decletter = Chr(233)
    Case 2
        decletter = Chr(235)
    Case 3
        decletter = Chr(236)
    Case 4
        decletter = Chr(238)
    Case 5
        decletter = Chr(240)
    Case 6
        decletter = Chr(241)
    Case 7
        decletter = Chr(242)
    Case 8
        decletter = Chr(244)
    Case 9
        decletter = Chr(246)
End Select
        
hebyearconv = Chr(250) & Chr(249) & IIf(un = 0, Chr(34), "") & decletter & IIf(un = 0, "", Chr(34)) & unletter

End Function

כעת תלחץ על Alt+Q

בעז"ה זה אמור לעבוד.

קובץ דוגמא: חוברת1.xlsm

[דוד 2421]

@פלורידה
החוברת שהאתה שלחת לי יש סימון של₪₪₪₪₪ בתוך הקוביה אחרי שמוחק אותה כדי להעתיק אותה אצלי כבר לא מופיע תאריך גם שממלא אותה שוב אולי תדריך אותי איך פשוט לקחת מהחוברת ולהעתיק ישירות אלי
דבר אחרון אפשר תאריך לועזי במקום העיברי מה אני אמור לשנות בפונקציה
ותודה רבה על הכל אשלח לך את הטבלה ש 99% היא בזכותך ישכח

[פלורידה]

@דוד-2421 כתב בבירור | אקסל עזרה פשוטה:

דבר אחרון אפשר תאריך לועזי במקום העיברי מה אני אמור לשנות בפונקציה

אולי תאמר לי למה עדיף לועזי, שנדע לפתור את הבעיה משורשה.

[פלורידה]

@דוד-2421 כתב בבירור | אקסל עזרה פשוטה:

סימון של₪₪₪₪₪ בתוך הקוביה

זה בעצם סולמיות.
כאשר התוכן שבתוך תא אקסל לא נכנס בגודל התא, הוא מראה את זה ככה.
אם תמתח את התא תראה שזה בעצם תאריך.

@דוד-2421 כתב בבירור | אקסל עזרה פשוטה:

אולי תדריך אותי איך פשוט לקחת מהחוברת ולהעתיק ישירות אלי

כמו שכבר אמרתי:

מורכב מאוד

אין דרך פשוטה להעתיק. אתה צריך ליצור את מה שאמרתי לך לפי השלבים הנ"ל. או שתעלה את המסמך שלך, ואני בלי נדר אעשה זאת עבורך כשאתפנה.

[יהודה האלקטר 1]

@פלורידה
הכי טוב תודה

[פלורידה]

@יהודה-האלקטר-1 כתב בבירור | אקסל עזרה פשוטה:

@פלורידה
הכי טוב תודה

אני לא רואה שהעלת את הקובץ

[יהודה האלקטר 1]

@פלורידה
היי סמנתי לך בתוך התבלה חץ אדום אם תוכל להשים תאריך לועזי כל פעם שממלאים וי בתוך הקוביה טקסט קישור
16b34e58-2d4c-4794-9b7a-c3f595a79f11-mmmmmmטבלה קל מעולה.xlsm
ואם תדריך אותי לשכפל בתוך הקובץ זה יהיה מושלם ותוכל לעשות רק בתור אחד והמשיך לבד לשאר המסכתות ישכח

[פלורידה]

@יהודה-האלקטר-1 כתב בבירור | אקסל עזרה פשוטה:

@פלורידה
היי סמנתי לך בתוך התבלה חץ אדום אם תוכל להשים תאריך לועזי כל פעם שממלאים וי בתוך הקוביה טקסט קישור
16b34e58-2d4c-4794-9b7a-c3f595a79f11-mmmmmmטבלה קל מעולה.xlsm
ואם תדריך אותי לשכפל בתוך הקובץ זה יהיה מושלם ותוכל לעשות רק בתור אחד והמשיך לבד לשאר המסכתות ישכח

מצטער אני לא יודע.
מה שאני יודע לעשות, זה כמו בהדרן עלך.

[יהודה האלקטר 1]

@פלורידה
בסדר גם מעולה מה שעשית בהדרן רק הקישור ששלחת לא נתפס על הקובץ תוכל בבקשה לעשות על הלוח שאשלח לך שוב יותר מסודר וקטן

[יהודה האלקטר 1]

@יהודה-האלקטר-1
מצרף הקובץ מחקתי כל החומר רק טבלה עם סימון תוכל לעדכן לפי זמן לועזי תודה
היכן שסמנתי בטוש שם תעדכן את הפונקציה תודה
פלורידה היקר.xlsx

[פלורידה]

@יהודה-האלקטר-1
פלורידה-היקר.xlsm

שתי לחיצות על כל מקום שיהיה מוגדר "עמודה אחת" יעשה לך את העבודה.

[יהודה האלקטר 1]

@פלורידה תודה רבה
אבל אשמח שמשהוא בפורום ינסה את הקובץ לא יודע לוחץ פעמים לא נותן כלום רק בתור 10 11 מופיע
יש אחד שנתן נוסחא לזה אעלה אותה כאן תגידו לי אם זה עובד אני לא הצלחתי

[פלורידה]

@יהודה-האלקטר-1 כתב בבירור | אקסל עזרה פשוטה:

@פלורידה תודה רבה
אבל אשמח שמשהוא בפורום ינסה את הקובץ לא יודע לוחץ פעמים לא נותן כלום רק בתור 10 11 מופיע
יש אחד שנתן נוסחא לזה אעלה אותה כאן תגידו לי אם זה עובד אני לא הצלחתי

הקובץ הזה מצויין.
אתה צריך לאפשר למאקרו לפעול אצלך.
לך לפי ההוראות האלו:
https://mitmachim.top/post/728965
כמובן בהתאמה לאקסל.

[יהודה האלקטר 1]

@פלורידה בדקתי עשיתי לא עובד אולי משהוא יכול להוריד הקובץ לראות אולי אצלו זה כן עובד

https://mitmachim.top/post/753126

[פלורידה]

@יהודה-האלקטר-1 כתב בבירור | אקסל עזרה פשוטה:

@פלורידה בדקתי עשיתי לא עובד אולי משהוא יכול להוריד הקובץ לראות אולי אצלו זה כן עובד

https://mitmachim.top/post/753126

בדקתי כעת.
זה עובד.
אולי שכחתי להדגיש לך, שהלחיצה היא "דאבל קליק". כלומר שתי לחיצות רצופות עם העכבר.

הקלטה 2024-02-18 002550.mp4