1
ห้อง MS Access / : MsgBox ขึ้นชื่อคนที่ CheckBox ถูก
« เมื่อ: 04 พ.ค. 65 , 15:04:34 »
ตัวอย่างแบบนี้ได้หรือเปล่าครับ
โพสต์นี้ได้รับคำขอบคุณจาก: nonc31
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Dim strString As String
Dim strArray() As String
Dim intCounter As Integer
strString = Me.Text4
strArray = Split(strString, ",")
For intCounter = 0 To UBound(strArray)
Me.ข้อมูล = strArray(intCounter)
DoCmd.GoToRecord , , acNext
Next intCounter
Sub FieldNames()
Dim rst, rstOut, strTable As Recordset
Dim f As Field
Dim SQL, RecordName As String
Set rst = CurrentDb.OpenRecordset("tbTarang1")
Set rstOut = CurrentDb.OpenRecordset("tbfild1")
rst.MoveFirst
Do Until rst.EOF
RecordName = rst!fname
Set strTable = CurrentDb.OpenRecordset(RecordName)
For Each f In strTable.Fields
rstOut.AddNew
rstOut![tarang] = RecordName
rstOut![fild] = f.Name
rstOut.Update
Next
rst.MoveNext
Loop
rst.Close: Set rst = Nothing
rstOut.Close: Set rstOut = Nothing
strTable.Close: Set strTable = Nothing
End Sub
ถ้าเราต้องการให้แยก Field ในตาราง ครับ เราต้องเพิ่มทุกช่องใช่ไหมครับ
เช่น ถ้าเราใส่ตรง Number 1 - 10
ก่จะได้
Runnum : AAA 10ตัว
Runnum1 : 2010 10ตัว
Runnum2 : 0001-0010
Dim strNum As String
Dim I As Long
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("table1", DB_OPEN_DYNASET)
For I = Me.txtBeginNumber To Me.txtEndNumber
strNum = Right("00000" & I, 4)
rs.AddNew
rs![Runnum] = Me.txtModel
rs![Runnum1] = Me.txtYear
rs![Runnum2] = strNum
rs.Update
Next
rs.Close
db.Close
Set rs = Nothing: Set db = Nothing
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strWong_Code As String
Dim strMember_Code As String
Dim SQL As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("TB2", dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveFirst
strWong_Code = rst![วง]
strMember_Code = rst![สมาชิก]
rst.MoveNext
Do Until rst.EOF
If strWong_Code = rst![วง] Then
strMember_Code = strMember_Code & "," & rst![สมาชิก]
Else
DoCmd.SetWarnings False
SQL = "UPDATE TB1 " & _
"SET samachik= '" & strMember_Code & "'" & _
"WHERE [รหัส] = '" & strWong_Code & "'"
DoCmd.RunSQL SQL
strWong_Code = rst![วง]
strMember_Code = rst![สมาชิก]
End If
rst.MoveNext
Loop
DoCmd.SetWarnings False
SQL = "UPDATE TB1 " & _
"SET samachik= '" & strMember_Code & "'" & _
"WHERE [รหัส] = '" & strWong_Code & "'"
DoCmd.RunSQL SQL
DoCmd.SetWarnings True
End If
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
ปัญหาคือ เวลาผมเลือก รายการใน combobox1 แล้วไฟของปุ่ม Numlock ชอบดับเองตลอดเวลา แล้วเวลาเลือกรายการอีกตรั้งก็จะติด เลือกรายการครั้งที่ 3 ก็จะดับ
ช่วยด้วยครับคืออยากให้ไฟติดตลอดเวลาไม่ว่ากี่ครั้งที่เลือกรายการครับ เป็น Windows 10 , Access 2007 ครับ
Option Compare Database
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
Function IsNumLockOn() As Boolean
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsNumLockOn = keys(VK_NUMLOCK)
End Function
Sub ToggleNumLock()
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=====Win95
keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK))
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=====WinNT
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End Sub
Sub mySendKeys(sKeys As String, Optional bWait As Boolean = False)
Dim bNumLockState As Boolean
bNumLockState = IsNumLockOn()
SendKeys sKeys, bWait
If IsNumLockOn() <> bNumLockState Then
ToggleNumLock
End If
End Sub
Private Sub Combo1_GotFocus()
Call ToggleNumLock
End Sub
Function InsertSpace(strInput As String, n As Long) As String
Dim strTemp As String
Dim lngIndex As Long
For lngIndex = 1 To Len(strInput) Step n
strTemp = strTemp & " " & Mid$(strInput, lngIndex, n) 'ตรง " " อยากให้กว้างกว่านี้อีกก็กด spacebar เพิ่มอีกได้
Next lngIndex
InsertSpace = Mid$(strTemp, 2)
End Function
=InsertSpace([POSID],1) '1 คือให้เว้นช่องทุก 1 ตัวอักษรนะครับ ถ้าอยากให้ แบ่งทุก 3 ตัวอักษรใส่เลข 3 แทนได้