แสดงกระทู้
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.
Private Sub BtnPrint_Click()
DoCmd.SelectObject acForm, “Frm_original”, True
DoCmd.PrintOut , , , , 1
DoCmd.SelectObject acForm, “Frm_Copy”, True
DoCmd.PrintOut , , , , 1
End Subเท่านี้ก็จะทำการปริ้น ทั้ง 2 ฟอร์ม โดยไม่ต้องเปิดฟอร์มขึ้นมาก็ได้คับ
มีแบบส่งรายบุคคลมั้ยครับพี่
Me.MxColor.BackColor = "&H" & Right$(strColor, 2) & Mid$(strColor, 3, 2) & Left$(strColor, 2)Function RGBtoHEX(R As Byte, G As Byte, B As Byte) As String
If R < 16 Then
HEX1 = 0 & Hex(R)
Else
HEX1 = Hex(R)
End If
If G < 16 Then
HEX2 = 0 & Hex(G)
Else
HEX2 = Hex(G)
End If
If B < 16 Then
HEX3 = 0 & Hex(B)
Else
HEX3 = Hex(B)
End If
RGBtoHEX = HEX1 & HEX2 & HEX3
End Functionขอบคุณครับ
Function MyHexColor(ByVal StrHex)
If Len(StrHex) = 7 Then StrHex = Mid(StrHex, 2, 6)
If Len(StrHex) = 6 Then
num_array = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f")
char1 = LCase(Mid(StrHex, 1, 1))
char2 = LCase(Mid(StrHex, 2, 1))
char3 = LCase(Mid(StrHex, 3, 1))
char4 = LCase(Mid(StrHex, 4, 1))
char5 = LCase(Mid(StrHex, 5, 1))
char6 = LCase(Mid(StrHex, 6, 1))
For i = 0 To 15
If (char1 = num_array(i)) Then position1 = i
If (char2 = num_array(i)) Then position2 = i
If (char3 = num_array(i)) Then position3 = i
If (char4 = num_array(i)) Then position4 = i
If (char5 = num_array(i)) Then position5 = i
If (char6 = num_array(i)) Then position6 = i
Next
If IsEmpty(position1) Or IsEmpty(position2) Or IsEmpty(position3) Or IsEmpty(position4) Or IsEmpty(position5) Or IsEmpty(position6) Then
MyHexColor = -1
Else
MyHexColor = RGB(position1 * 16 + position2, position3 * 16 + position4, position5 * 16 + position6)
End If
Else
MyHexColor = -1
End If
End FunctionPrivate Sub รายละเอียด_Paint()
If Not IsNull(Me.HEX) Then
Me.COLOR.BackColor = MyHexColor(HEX)
Else
Me.COLOR.BackColor = MyHexColor("#FFFFFF")
End If
End Sub
ทดสอบเปลี่ยนเดือน เลขสามตัวท้ายไม่กลับไปเริ่มนับ 001 นะครับ (ฉบับมาโครก็เช่นเดียวกัน)
RunnungNum myDate Data 6107001 26-07-18 11 6107002 26-07-18 22 6108003 01-08-18 33 6108004 01-08-18 44 6109005 01-09-18 55 6109006 01-09-18 66
Private Sub Data_AfterUpdate()
Dim fixyear As String
If GetUserLocaleInfo(GetSystemDefaultLCID(), &H1009) = 7 Then
Me.RunnungNum = Format(Me.txtDate, "YY") & Format(Me.txtDate, "MM") & Right("00" & DCount([myDate], "[tblRunningNumber]") + 1, 3)
ElseIf GetUserLocaleInfo(GetSystemDefaultLCID(), &H1009) <> 7 Then
fixyear = bYear(Me.txtDate)
Me.RunnungNum = Right(fixyear, 2) & Format(Me.txtDate, "MM") & Right("00" & DCount([myDate], "[tblRunningNumber]") + 1, 3)
End If
End Sub
