אופיס 365 אותיות במקום מספרים באקסס

[צבי]

שאלה: איך מתרגמים מספרים לאותיות באקסס כגון מס' 16 יהיה טז ?

 

[SHL]

באמצעות מבנה שליטה-Case
מצטער אבל אני יכול להעלות דוגמא רק בעוד יומיים

 

[אריה123]

ניתן ליצור פונקציה שמשנה את זה (הפונקציה תיבנה באופן ידני אבל אח"כ הכל ילך באופן אוטומט&#1497

 

[saryoram]

בבקשה:

[SIZE=2]Option Compare Database[/SIZE]
[SIZE=2]Option Explicit[/SIZE]
 
[SIZE=2]'[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]מתרגם ערך מספרי למחרוזת אותיות לפי גימטריה של האותיות , כגון - 123 מתרגם ל:קכג[/SIZE][/FONT]
[SIZE=2]'[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]כלומר, מתייחס לכל סיפרה כגימטריה של אות מסויימת, ומוצא אות זו[/SIZE][/FONT]
[SIZE=2]Public Function GematriaValueChar(num As Long) As String[/SIZE]
[SIZE=2]Dim Number As Integer '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]מנה[/SIZE][/FONT]
[SIZE=2]Dim RemainderNum As Integer '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]שארית[/SIZE][/FONT]
[SIZE=2]Dim Number2 As Integer[/SIZE]
[SIZE=2]Dim PageStr As String[/SIZE]
[SIZE=2]Dim PageChar As String[/SIZE]
[SIZE=2]Dim n As Integer[/SIZE]
[SIZE=2]Dim pos As Integer[/SIZE]
 
[SIZE=2]If num = 0 Then Exit Function[/SIZE]
 
[SIZE=2]PageStr = ""[/SIZE]
[SIZE=2]n = 0[/SIZE]
[SIZE=2]Number = num \ 10[/SIZE]
[SIZE=2]RemainderNum = num Mod 10[/SIZE]
[SIZE=2]Do While 1[/SIZE]
[SIZE=2]If RemainderNum = 0 Then[/SIZE]
[SIZE=2]GoTo division[/SIZE]
[SIZE=2]Else[/SIZE]
[SIZE=2]Number2 = RemainderNum * 10 ^ n[/SIZE]
[SIZE=2]End If[/SIZE]
 
[SIZE=2]PageChar = ClacGematriaChar(Number2)[/SIZE]
[SIZE=2]PageStr = PageChar & PageStr[/SIZE]
 
[SIZE=2]If RemainderNum = 0 Or Number = 0 Then Exit Do[/SIZE]
 
[SIZE=2]division: RemainderNum = Number Mod 10[/SIZE]
[SIZE=2]Number = Number \ 10[/SIZE]
[SIZE=2]n = n + 1[/SIZE]
 
[SIZE=2]Loop[/SIZE]
 
[SIZE=2]'=================================================[/SIZE]
[SIZE=2]'[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]מחליף את "יה" ב"טו" ואת "יו" ב"טז[/SIZE][/FONT]
[SIZE=2]pos = InStr(1, PageStr, "[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]יה[/SIZE][/FONT][SIZE=2]", vbTextCompare)[/SIZE]
[SIZE=2]If pos Then PageStr = Mid(PageStr, 1, pos - 1) & "[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]טו[/SIZE][/FONT][SIZE=2]"[/SIZE]
 
[SIZE=2]pos = InStr(1, PageStr, "[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]יו[/SIZE][/FONT][SIZE=2]", vbTextCompare)[/SIZE]
[SIZE=2]If pos Then PageStr = Mid(PageStr, 1, pos - 1) & "[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]טז[/SIZE][/FONT][SIZE=2]"[/SIZE]
[SIZE=2]'=================================================[/SIZE]
 
[SIZE=2]GematriaValueChar = PageStr[/SIZE]
 
[SIZE=2]End Function[/SIZE]
[SIZE=2]'[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]מוצאת את האות המתאימה לכל סיפרה[/SIZE][/FONT]
[SIZE=2]Public Function ClacGematriaChar(KeyAscii As Integer) As String[/SIZE]
[SIZE=2]Select Case KeyAscii[/SIZE]
[SIZE=2]Case 1 To 10 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האותיות א-י[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(KeyAscii + 223)[/SIZE]
[SIZE=2]Case 20 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות כ[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(235)[/SIZE]
[SIZE=2]Case 30 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ל[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(236)[/SIZE]
[SIZE=2]Case 40 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות מ[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(238)[/SIZE]
[SIZE=2]Case 50 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות נ[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(240)[/SIZE]
[SIZE=2]Case 60 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ס[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(241)[/SIZE]
[SIZE=2]Case 70 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ע[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(242)[/SIZE]
[SIZE=2]Case 80 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות פ[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(244)[/SIZE]
[SIZE=2]Case 90 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות צ[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(246)[/SIZE]
[SIZE=2]Case 100 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ק[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(247)[/SIZE]
[SIZE=2]Case 200 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ר[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(248)[/SIZE]
[SIZE=2]Case 300 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ש[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(249)[/SIZE]
[SIZE=2]Case 400 '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]האות ת[/SIZE][/FONT]
[SIZE=2]ClacGematriaChar = Chr(250)[/SIZE]
[SIZE=2]End Select[/SIZE]
 
[SIZE=2]End Function[/SIZE]
[SIZE=2]' [/SIZE][FONT=Courier New (Hebrew)][SIZE=2]חישוב הערך הגימטרי של מחרוזת תווים, למשל כב = 22[/SIZE][/FONT]
[SIZE=2]Public Function GematriaValue(strg As String) As Long[/SIZE]
[SIZE=2]Dim i As Long[/SIZE]
[SIZE=2]Dim KeyAscii As Integer[/SIZE]
[SIZE=2]Dim GemValue As Integer[/SIZE]
 
[SIZE=2]For i = 1 To Len(strg)[/SIZE]
[SIZE=2]KeyAscii = Asc(Mid(strg, i, 1))[/SIZE]
 
[SIZE=2]' [/SIZE][FONT=Courier New (Hebrew)][SIZE=2]מציאת הערך הגימטרי[/SIZE][/FONT]
[SIZE=2]Select Case KeyAscii[/SIZE]
[SIZE=2]Case 224 To 233 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור האותיות א' - י[/SIZE][/FONT]
[SIZE=2]GemValue = (KeyAscii - 223)[/SIZE]
[SIZE=2]Case 234 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור ך[/SIZE][/FONT]
[SIZE=2]GemValue = 20[/SIZE]
[SIZE=2]Case 235 To 236 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור כ' ו-ל[/SIZE][/FONT]
[SIZE=2]GemValue = (KeyAscii - 233) * 10[/SIZE]
[SIZE=2]Case 237, 238 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור מ' ו-ם[/SIZE][/FONT]
[SIZE=2]GemValue = 40[/SIZE]
[SIZE=2]Case 239 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור ן[/SIZE][/FONT]
[SIZE=2]GemValue = 50[/SIZE]
[SIZE=2]Case 240 To 242 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור נ' - ע[/SIZE][/FONT]
[SIZE=2]GemValue = (KeyAscii - 235) * 10[/SIZE]
[SIZE=2]Case 243, 244 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור פ' ו-ף[/SIZE][/FONT]
[SIZE=2]GemValue = 80[/SIZE]
[SIZE=2]Case 245, 246 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור צ' ו-ץ[/SIZE][/FONT]
[SIZE=2]GemValue = 90[/SIZE]
[SIZE=2]Case 247 To 250 'I '[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]עבור ק' - ת[/SIZE][/FONT]
[SIZE=2]GemValue = (KeyAscii - 246) * 100[/SIZE]
[SIZE=2]End Select[/SIZE]
 
[SIZE=2]GematriaValue = GematriaValue + GemValue[/SIZE]
[SIZE=2]Next i[/SIZE]
[SIZE=2]End Function[/SIZE]

דוגמאות:

[SIZE=2]?GematriaValueChar(123)[/SIZE]
[FONT=Courier New (Hebrew)][SIZE=2]קכג[/SIZE][/FONT]
[SIZE=2]?GematriaValue("[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]קכג[/SIZE][/FONT][SIZE=2]")[/SIZE]
[SIZE=2]123 [/SIZE]

המקור מ http://www.dr-vb.co.il
קוד ודוגמאות נוספות: http://www.dr-vb.co.il/search.php?what=%E2%E9%EE%E8%F8%E9%E4&field=1

 

[אריה123]

קובץ דוגמא למה שהביאו למעלה

רק לפתוח ולהשתמש.... בהצלחה.
ותודה למי שהביא את הקוד הזה

 

[אריה123]

קובץ מתוקן

סליחה הקובץ הקודם אינו טוב... מצו"ב קובץ חדש

 

[אריה123]

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