אופיס 365 כך יוצרים בקלות פקד השלמה אוטומטית באקסס

[אפר]

לצורך מסוים יצרתי קוד שבקלות הופך תיבה משולבת לתיבת השלמה אוטומטית כלומר שמחפש בכל חלקי המילה ולא רק בתחילתה

יש ליצור מודול עם הקוד הבא:

Option Compare Database
Option Explicit

Public Function Chipush() As String
On Error Resume Next
Chipush = Screen.ActiveControl.Tag
End Function

Public Function ChipushShinuy()
If Screen.ActiveControl.HelpContextId = 1 Then Screen.ActiveControl.HelpContextId = 0: GoTo Hemshech
Screen.ActiveForm.ActiveControl.Tag = Screen.ActiveForm.ActiveControl.Text
Hemshech:
Screen.ActiveForm.ActiveControl.RowSource = Screen.ActiveForm.ActiveControl.RowSource
Screen.ActiveForm.ActiveControl.Dropdown
End Function

Public Function ChipushGotFocus()
On Error Resume Next
Screen.ActiveForm.ActiveControl.Tag = ""
Screen.ActiveForm.ActiveControl.RowSource = Screen.ActiveForm.ActiveControl.RowSource
End Function

Public Function ChipushKeyDown(KeyCode As Integer)
If KeyCode = 38 Or KeyCode = 40 Then Screen.ActiveControl.HelpContextId = 1: Screen.ActiveForm.ActiveControl.Dropdown
End Function

לאחר מכן בכל פקד שרוצים להכניס מכניסים בשאילתת מקור השורה את התנאי הבא בעמודה המתאימה :

ALike "%" & Chipush() & "%"

​

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

בעת שינוי:

ChipushShinuy()

בעת קבלת מוקד:

ChipushGotFocus()

בעת ירידת מקש:

ChipushKeyDown(KeyCode)

 

[אפר]

מיועד עבור איתור רשומה בעיקר
כי בטפסים רציפים זה יפריע לרשומות האחרות

ניתן לפתור ע"י
יצירה של שדה DLOOKUP שמסתיר את התיבה ומעליו תווית ריקה שבלחיצה מעבירה לתיבה המשולבת

 

[אפר]

על מנת שבאנטר יבחר את הראשון יש להוסיף למודול את זה

Public Function ChipushNotInList()
On Error Resume Next
Dim sql As Recordset
Set sql = CurrentDb.OpenRecordset(Screen.ActiveForm.ActiveControl.RowSource)
ChipushNotInList = sql(Screen.ActiveForm.ActiveControl.BoundColumn - 1)
End Function

ובאירוע לא ברשימה יש להכניס את זה

On Error Resume Next
Response = 0
Me.ActiveControl = ChipushNotInList
<<יש להחליף בשם הפקד>>_AfterUpdate

יש להגדיר הרחב אוטומטית ללא

 

[אפר]

<<יש להחליף בשם הפקד>>_AfterUpdate

במידת הצורך

 

[אפר]

בעת ירידת מקש:
ChipushKeyDown(KeyCode)

טעיתי יש לכתוב את זה
בעליית מקש

 

[אפר]

מתוקן

יש ליצור מודול עם הקוד הבא:
קוד:

Option Compare Database
Option Explicit

Public Function Chipush() As String
On Error Resume Next
Chipush = Screen.ActiveControl.Tag
End Function

Public Function ChipushShinuy()
On Error Resume Next
If Screen.ActiveControl.HelpContextId = 1 Then
Screen.ActiveControl.HelpContextId = 0
Else
Screen.ActiveControl.Tag = Screen.ActiveControl.Text
Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
Screen.ActiveControl.Dropdown
End If
End Function

Public Function ChipushGotFocus()
On Error Resume Next
Screen.ActiveControl.Tag = ""
Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
End Function

Public Function ChipushKeyUp(KeyCode As Integer)
On Error Resume Next
If KeyCode = 38 Or KeyCode = 40 Then
Screen.ActiveControl.Dropdown
End If
End Function

Public Function ChipushKeyDown(KeyCode As Integer)
On Error Resume Next
If KeyCode = 38 Or KeyCode = 40 Then
Screen.ActiveControl.HelpContextId = 1
Screen.ActiveControl.Dropdown
End If
End Function

Public Function ChipushNotInList()
On Error Resume Next
Dim Sql As Recordset
Set Sql = CurrentDb.OpenRecordset(Screen.ActiveControl.RowSource)
ChipushNotInList = Sql(Screen.ActiveControl.BoundColumn - 1)
End Function

לאחר מכן בכל פקד שרוצים להכניס מכניסים בשאילתת מקור השורה את התנאי הבא בעמודה המתאימה :

ALike "%" & Chipush() & "%"

לאחר מכן יש להכניס באירועים של התיבה המשולבת את הפונקציות כדלהלן​

בעת שינוי:

ChipushShinuy()

בעת קבלת מוקד:

ChipushGotFocus()

בעת ירידת מקש:

ChipushKeyDown(KeyCode)

בעת עליית מקש:

ChipushKeyUp(KeyCode)

בעת שלא ברשימה:

On Error Resume Next
Response = 0
Me.ActiveControl = ChipushNotInList
<<שם הפקד>>_AfterUpdate

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

 

[אפר]

מעודכן:

יש ליצור מודול מחלקה עם הקוד הבא:

Option Compare Database
Option Explicit

Private Direction As Boolean

Public Function ChipushShinuy()
    On Error Resume Next
    If Direction Then
        Direction = False
    Else
        Screen.ActiveControl.Tag = Screen.ActiveControl.Text
        Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
        Screen.ActiveControl.Dropdown
    End If
End Function

Public Function ChipushGotFocus()
    On Error Resume Next
    Screen.ActiveControl.Tag = ""
    Direction = False
    Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
End Function

Public Function ChipushKeyUp(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 38 Or KeyCode = 40 Then Direction = True
End Function

Public Function ChipushKeyDown(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 38 Or KeyCode = 40 Then Direction = True
End Function

Public Function ChipushNotInList()
    On Error Resume Next
    Dim Sql As Recordset
    Set Sql = CurrentDb.OpenRecordset(Screen.ActiveControl.RowSource)
    ChipushNotInList = Sql(Screen.ActiveControl.BoundColumn - 1)
    Set Sql = Nothing
End Function

​

במודול נוסף:

Option Compare Database
Option Explicit

Public Function Chipush() As String
    On Error Resume Next
    Chipush = Screen.ActiveControl.Tag
End Function

​

לאחר מכן בכל פקד שרוצים להכניס מכניסים בשאילתת מקור השורה את התנאי הבא בעמודה המתאימה :

ALike "%" & Chipush() & "%"

יש להגדיר הרחב אוטומטית ללא


לאחר מכן לגשת לVBA:
צריך לתת שם למודול הארוך (אני נתתי לדוג' clsChipush)
צריך לתת שם לכל פעם שמשתמשים לפקד (בדוג' Shem)
בחלק העליון של המודול של הטופס להוסיף

private <<שם באנגלית>> as <<שם המודול הארוך>>
דוג'
private Shem as clsChipush

ובעת טעינה של הטופס להוסיף

set <<השם באנגלית>> = new <<שם המודול הארוך>>
דוג'
set Shem = new clsChipush

לאחר מכן יש להכניס באירועים של התיבה המשולבת את הפונקציות כדלהלן:

בעת שינוי:

<<השם באנגלית>>.ChipushShinuy

בעת קבלת מוקד:

<<השם באנגלית>>.ChipushGotFocus

בעת ירידת מקש:

<<השם באנגלית>>.ChipushKeyDown KeyCode

בעת עליית מקש:

<<השם באנגלית>>.ChipushKeyUp KeyCode

בעת שלא ברשימה:

On Error Resume Next
Response = 0
Me.ActiveControl = <<השם באנגלית>>.ChipushNotInList
<<שם הפקד>>_AfterUpdate

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

 

[אפר]

מעודכן:

יש ליצור מודול מחלקה עם הקוד הבא:

Option Compare Database
Option Explicit

Private Direction As Boolean

Public Function ChipushShinuy()
    On Error Resume Next
    If Direction Then
        Direction = False
    Else
        Screen.ActiveControl.Tag = Screen.ActiveControl.Text
        Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
        Screen.ActiveControl.Dropdown
    End If
End Function

Public Function ChipushGotFocus()
    On Error Resume Next
    Screen.ActiveControl.Tag = ""
    Direction = False
    Screen.ActiveControl.RowSource = Screen.ActiveControl.RowSource
End Function

Public Function ChipushKeyUp(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 38 Or KeyCode = 40 Then Direction = True
End Function

Public Function ChipushKeyDown(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 38 Or KeyCode = 40 Then Direction = True
End Function

Public Function ChipushNotInList()
    On Error Resume Next
    Dim Sql As Recordset
    Set Sql = CurrentDb.OpenRecordset(Screen.ActiveControl.RowSource)
    ChipushNotInList = Sql(Screen.ActiveControl.BoundColumn - 1)
    Set Sql = Nothing
End Function

​

במודול נוסף:

Option Compare Database
Option Explicit

Public Function Chipush() As String
    On Error Resume Next
    Chipush = Screen.ActiveControl.Tag
End Function

​

לאחר מכן בכל פקד שרוצים להכניס מכניסים בשאילתת מקור השורה את התנאי הבא בעמודה המתאימה :

ALike "%" & Chipush() & "%"

יש להגדיר הרחב אוטומטית ללא


לאחר מכן לגשת לVBA:
צריך לתת שם למודול הארוך (אני נתתי לדוג' clsChipush)
צריך לתת שם לכל פעם שמשתמשים לפקד (בדוג' Shem)
בחלק העליון של המודול של הטופס להוסיף

private <<שם באנגלית>> as <<שם המודול הארוך>>
דוג'
private Shem as clsChipush

ובעת טעינה של הטופס להוסיף

set <<השם באנגלית>> = new <<שם המודול הארוך>>
דוג'
set Shem = new clsChipush

לאחר מכן יש להכניס באירועים של התיבה המשולבת את הפונקציות כדלהלן:

בעת שינוי:

<<השם באנגלית>>.ChipushShinuy

בעת קבלת מוקד:

<<השם באנגלית>>.ChipushGotFocus

בעת ירידת מקש:

<<השם באנגלית>>.ChipushKeyDown KeyCode

בעת עליית מקש:

<<השם באנגלית>>.ChipushKeyUp KeyCode

בעת שלא ברשימה:

On Error Resume Next
Response = 0
Me.ActiveControl = <<השם באנגלית>>.ChipushNotInList
<<שם הפקד>>_AfterUpdate

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

נערך

 

[ari rm]

@אפר הקוד הנ"ל יעבוד טוב גם בטפסים רציפים, או שזה לא הגיוני בכלל?
אם אכן זה לא הגיוני יש רעיון לכזה דבר?

 

[אפר]

@אפר הקוד הנ"ל יעבוד טוב גם בטפסים רציפים, או שזה לא הגיוני בכלל?
אם אכן זה לא הגיוני יש רעיון לכזה דבר?

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