แสดงกระทู้

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.


Messages - ปิ่นณรงค์

หน้า: 1 2 3 [4] 5 6 7 ... 32
55
อ้างถึง
หนูต้องการอยากจะตรวจสอบชื่อไฟล์ว่า หากไฟล์ที่เปิดนั้น เพียงมีชื่อ ขึ้นต้นด้วยคำว่า"Backup" ก็ให้มีการแจ้งเตือนดังกล่าวทันที

ถ้าจะสร้างการตรวจสอบเมื่อเปิดไฟล์ขึ้นมางั้นเราจะเพิ่มโค้ดตรวจสอบไว้ที่ AutoExec นะครับ
โดย Macro และ Module นี้นำไปไว้ที่ โปรแกรมหลักของเราเลย เวลา Copy ไฟล์ Macro และ Module นี้จะติดมาด้วย

ขั้นตอนที่ 1 สร้าง Module ใส่
โค๊ด: [Select]
Public Function AutoExec_AutoExec()
On Error GoTo AutoExec_AutoExec_Err
   Dim strFileName As String
   Dim DFileName As String
   
   strFileName = CurrentProject.Path & "\" & CurrentProject.Name
    DFileName = Dir(strFileName)
   
   If Left(DFileName, 6) = "Backup" Then
   MsgBox "ไฟล์นี้เป็นไฟล์สำรองไม่ควรเปิดใช้งานจนกว่าจะเปลี่ยนชื่อไฟล์ใหม่", vbInformation, "แจ้งเตือน"
    DoCmd.Quit
   End If
AutoExec_AutoExec_Exit:
    Exit Function
   
AutoExec_AutoExec_Err:
    MsgBox Error$
    Resume AutoExec_AutoExec_Exit
   
End Function

ขั้นตอนที่ 2 สร้างมาโครขึ้นมา 1 อันใส่โค้ดนี้ไปตั้งชื่อว่า AutoExec


เท่านี้เวลาเปิดไฟล์ไหนก็แล้วแต่ที่ Copy มา ถ้าไฟล์ ชื่อขึ้นต้นด้วย BackUp ก็จะแสดง Msgbox แจ้งเตือนทันทีคับ

ผมมีตัวอย่างไฟล์ ลองกด Botton Copy แล้วไปลองเปิดไฟล์ Backup ที่ Drive D ดูครับ

56
ขออนุญาตใช้กระทู้นี้ต่อคำถามเพิ่มเติมนะคะ
 หนูมีโปรเจ็คชื่อ Sample หนูลองนำคำสั่งในนี้ไปประยุกต์ใช้เป็นดังนี้
โค๊ด: [Select]
oFSO.CopyFile CurrentProject.Path & "\" & CurrentProject.Name, "D:\" & "Backup " & CurrentProject.Name
ซึ่งมันก็ใช้ได้ดีเลยทีเดียว โดยจะได้ไฟล์สำรองเป็น BackupSample ตามที่ต้องการ
ประเด็นปัญหาก็คือ หากเราไปเปิดตัวไฟล์สำรอง BackupSample แล้วสั่งสำรองข้อมูล
มันก็จะได้ไฟล์สำรองตัวใหม่เป็น BackupBackupSample

หนูจึงอยากได้ว่า หากมีการเปิดไฟล์โปรเจ็คที่ มีชื่อขึ้นต้นว่า Backup
ก็ให้มีข้อความบอกผู้ใช้ว่า"ไฟล์นี้เป็นไฟล์สำรองไม่ควรเปิดใช้งานจนกว่าจะเปลี่ยนชื่อไฟล์ใหม่" ประมาณนี้ค่ะ
ไม่ทราบว่าต้องทำอย่างไรคะ

สร้าง Function มาเช็คดูก็ได้คับ ว่าไฟล์เปิดใช้งานจริงหรือไม่

โค๊ด: [Select]
Function checkFileOpen(FilePath As String)
    Dim iFile As Long
    Dim OnErr As Long
    On Error Resume Next
    iFile = FreeFile()
    Open FilePath For Input Lock Read As #iFile

    Close iFile
    OnErr = Err
    On Error GoTo 0
     
    Select Case OnErr
    Case 0:    checkFileOpen = False
    Case 70:   checkFileOpen = True
    End Select
     
End Function

Private Sub Command0_Click()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

If checkFileOpen("D:\" & "Backup " & CurrentProject.Name) = False Then
   oFSO.CopyFile CurrentProject.Path & "\" & CurrentProject.Name, "D:\" & "Backup " & CurrentProject.Name
   Set oFSO = Nothing
   
Else
    MsgBox "ไฟล์นี้เป็นไฟล์สำรองไม่ควรเปิดใช้งานจนกว่าจะเปลี่ยนชื่อไฟล์ใหม่", vbInformation, "แจ้งเตือน"
End If
End Sub

57
List ชื่อไฟล์ในโฟลเดอร์ และในซับโฟลเดอร์เข้าสู่  Table ทีเคยเห็นมีแต่แสดงลงใน ComboBox , ListBox แต่ยังไม่เคยเห็นลงใน Table เลยครับ

ช่วยผมที่ครับ
ใน Table จะมี
---------------
Filename
Path
Date_Modified

ผมได้สร้างตัวอย่างโดยเอาโค้ดจากเว็บนอกครับ เครดิต Allen Browne นะครับ มาประยุกต์ใช้กับตัวอย่างนี้
น่าจะตอบโจทย์ที่คุณอยากได้

คุณสามารถนำไปกำหนดค่าเพิ่มเติมได้เช่น

Private Sub Command2_Click()
Dim StrFloderpath As String
Dim strPath As String
Dim strFileSpec As String
Dim booIncludeSubfolders As Boolean

    StrFilePath = Me.txtFloderpath
    strPath = StrFilePath
    strFileSpec = "*.*"            'ค้นหากำหนดคุณลักษณะเช่นหาเฉพาะไฟล์นามสกุลที่ระบุเช่น  strFileSpec = "*.doc"    เป็นต้น
    booIncludeSubfolders = True  ' กำหนดให้ค้นหาได้ว่าเอาเฉพาะ Folder หลัก (กำหนดเป็น False) หรือหาใน SubFolder ด้วย (True)
    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders
End Sub



58
ถ้าใช้การสร้าง Unbound Control ไว้ส่วนหัวแล้วกรอกข้อมูลจากบนนี้ น่าจะพอทำได้คับ
ส่วนการให้ข้อมูลล่าสุดมาแสดงบนสุด ผมใช้การสร้างฟิลล์ อีกฟิลล์ datatype Date/Time กำหนด ค่าเริ่มต้นเป็น Now แล้วกรองค่าจากมากไปหาน้อยครับ
หรือถ้ามี ID แบบ Autonumber ก็เอามากรองได้เลยครับไม่ต้องสร้างฟิลล์เพิ่ม
ตัวอย่างด้านล่าง


59
ห้อง MS Access / : Modul not found
« เมื่อ: 07 พ.ค. 62 , 08:38:54 »
พอดีเปิด 64bit ไม่ได้ แต่พอแปลงเป็น 32bit ลองเปิดดูเปิดได้ปกติ

60
:sweat:Copy File ไปใช้อีกเครื่อง Listbox ในฟอร์ม ไม่ทำงานเลือกเลื่อน แล้วชุดข้อมูลไม่เปลี่ยนให้ Access2013 ทั้ง 2 เครื่อง
รบกวนด้วยครับ

นำไปใช้เครื่องอื่น เปิด Trust Center ให้ Macro ทำงานได้หรือยังครับ

ลองดูวิธีตามนี้ครับ
https://www.ugetproject.com/wp/ms-office-access/ตั้งค่าให้vbaทำงาน.html

61
ปัญหานี้อาจจะเกิดจาก References ไม่ครบถ้วน หรือเปล่า ลอง เอาหน้า References มาดูหน่อยครับ
แจ้ง version ของ Office ด้วยนะ
การตรวจสอบ เปิดหน้าต่างเขียนโค้ด หรือที่ งานของเรากด Alt+F11  เลือกรายการ tab ชื่อ  Tools > References. 
แล้วลองตรวจเช็คดูครับ
ของผมปกติเจออย่างต่ำก็ 4 รายการคับ

62
Combobox นิยมใช้ในการเลือกรายการหรือเลือกจากตัวเลือกที่สร้างขึ้นมามากกว่าจะใช้การ ใส่ตัวเลขนะครับ
แต่ถ้าใส่ตัวเลือก จาก ID แล้ว แสดงส่วนของ Detail ก็ว่าไปอย่าง
ถ้าเป็นการใส่ตัวเลขก็ใช้ textbox ก็ได้ เลยสงสัยว่าการนำไปใช้ๆทำอะไรครับ

เช่น
โค๊ด: [Select]
Private Sub Combo_Box_1_AfterUpdate()
If Not IsNull(Me.Combo_Box_1) Then
Me.Combo_Box_2 = Me.Combo_Box_1
Me.Combo_Box_3 = Me.Combo_Box_1
End If
End Sub




63
เราเอา code ไปใส่ใน module ได้ไหมครับ  เพราะทุกฟอร์มที่เปิดจะ เปิดใช้เหมือนกัน  จะได้ไม่ต้องไใส่ใน form load   ของ property
ท่านไปกำหนดของแต่ละฟอร์ม ก่อนเรียก Function มาใช้นะครับ


ที่ Module

โค๊ด: [Select]
Public Function MyKeyCode(KeyCode As Integer, Shift As Integer) As Integer
    Select Case KeyCode
        Case vbKeyF1
            MyKeyCode = 0
         MsgBox "F2 = Previous Record" & vbCrLf & "F3 = Next Record" & vbCrLf & _
         "F4 = Save Record" & vbCrLf & "F8 = Open Reports" & vbCrLf & _
         "F10 = Save And Exit", vbInformation + vbSystemModal, "HELP"
         
         Case vbKeyF2
            MyKeyCode = 0
             On Error Resume Next
             DoCmd.GoToRecord , , acPrevious
           
         Case vbKeyF3
            MyKeyCode = 0
            On Error Resume Next
            DoCmd.GoToRecord , , acNext
       
          Case vbKeyF4
            MyKeyCode = 0
            DoCmd.RunCommand acCmdSaveRecord
           
            Case vbKeyF8
            MyKeyCode = 0
            DoCmd.OpenReport "Report1", acViewNormal
         
             Case vbKeyF10
                DoCmd.Close , , acSaveYes
       
        Case Else
            MyKeyCode = KeyCode
    End Select
End Function

ที่ฟอร์มแต่ละฟอร์ม Event Keydown เอาโค้ดนี้ไปวางไว้ได้เลย
โค๊ด: [Select]
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
KeyCode = MyKeyCode(KeyCode, Shift)
End Sub

หมายเหตุที่ Select Case แต่ละอันท่านไปปรับเปลี่ยนการทำงานได้ตามสะดวกครับ

64
สร้าง แถบ Ribbon มาใช้เองก็ได้คับ แล้วเลือก สัญลักษณ์เครื่องปริ้นมาแสดงไว้พอจะปริ้น ก็ Ribbon เอาเลย

65
อยากนำ ฟังก์ชั่นคีย์ แทน command bottom เขียน code อย่างไรครับ
F1=help   f2= previous record  F3=next record  F4=Save record  F8=print report  F10=save & exit


โค๊ด: [Select]
Private Sub Form_Load()
Me.KeyPreview = True  'เปิดรับสถานะการกดแป้นคีย์บอร์ด
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
        Case vbKeyF1
         KeyCode = 0
         MsgBox "F2 = Previous Record" & vbCrLf & "F3 = Next Record" & vbCrLf & _
         "F4 = Save Record" & vbCrLf & "F8 = Open Reports" & vbCrLf & _
         "F10 = Save And Exit", vbInformation + vbSystemModal, "HELP"
         Case vbKeyF2
         KeyCode = 0
         Me.Recordset.MovePrevious
         Case vbKeyF3
         KeyCode = 0
         Me.Recordset.MoveNext
        Case vbKeyF4
        Me.Dirty = False 'หรืออื่นๆ เขียน sub มา ก็ได้
        Case vbKeyF8
        DoCmd.OpenReport "Report1", acViewNormal
        Case vbKeyF10
         Me.Dirty = False
         DoCmd.Close
    End Select
End Sub



ลองนำไปปรับใช้ดูครับ



66
แก้เป็นแบบนี้ได้ไหม เป็นการกำหนดเงื่อนไขว่า ถ้า textbox barcode ว่าง ก็ให้ออกจากการทำงานที่เหลือ

โค๊ด: [Select]
Private Sub Command122_Enter()
On Error Resume Next
if isnull(me.Barcode) then
Me.Barcode.SetFocus
exit sub
else
Forms("Sale").subformsale.Form.Item_no = Barcode
subformsale.SetFocus
DoCmd.GoToRecord , , acNewRec
DoCmd.GoToControl "Barcode"
Barcode.SetFocus
Barcode = Null
end if
End Sub

67
ตรงนี้แค่สร้างตัวแปลมาตรวจสอบ ครับ กำหนด Format วันที่แบบไหนก็ได้คับอะไรก็ได้ครับ ขอแค่ให้หมือนกัน จะใช้ DD/MM/YY ก็ได้เหมือนกันคับ


68
ทำไมรวน เลขที่บิลไม่ running ย่ำอยู่กับเลขเดิม อจ.ช่วยกรุณาชี้จุดทีครับ 
 

คุณต้องดูจาก ตัวอักษรที่ใช้อ้างถึงด้วยครับ
Fuction Mid ตัวอย่าง
https://www.techonthenet.com/access/functions/string/mid.php
Fuction Left คือนับจำนวนตัวอักษรจากทางซ้ายไปกี่ตัว ถ้ารหัสเป็น PANV62-05-02-01
Left 12 คือ PANV62-05-02 ครับ ส่วนที่เหลือ จะได้จาก INTMAX มา+1

ถ้า 2 หลัก แบบ IV Mid 12 Left 10
ถ้า 4 หลัก แบบ PANV Mid ต้อง 14 Left 12

แก้ใหม่ก็ได้แบบนี้
โค๊ด: [Select]
Private Sub Command0_Click()
Dim StrVoucher_date As String
Dim StrtoDay As String
If Not IsNull(Me.Voucher_date) Then
StrVoucher_date = Format(Voucher_date, "D/M/YY")
StrtoDay = Format(Now, "D/M/YY")
If StrVoucher_date = StrtoDay Then
Call ForIsToday
Else
Call ForIsOtherday
End If
End If
End Sub
Sub ForIsToday()
Dim strDate As String
Dim intNum As Integer, intMax As Integer
Dim strSuffix As String
strDate = "PANV" & "" & (Format(Now, "yy-mm-dd"))
    If Me.voucher_id = "" Or IsNull(Me.voucher_id) Then
   
        If IsNull(DMax("Val(Mid([voucher_id],14))", "voucher", "Left([Voucher_id],12) = '" & strDate & " '")) Then
            Me.voucher_id = strDate & "-" & "01"
            Debug.Print "1"
        Else
            intMax = DMax("Val(Mid([Voucher_Id],14))", "voucher", "Left([Voucher_id],12) = '" & strDate & " '")
                       intMax = intMax + 1
            Me.voucher_id = strDate & "-" & Format(intMax, "00")
            Debug.Print "1"
        End If
End If
End Sub

Sub ForIsOtherday()
Dim strDate As String
Dim intNum As Integer, intMax As Integer
Dim strSuffix As String
strDate = "PANV" & "" & (Format(Voucher_date, "yy-mm-dd"))
    If Me.voucher_id = "" Or IsNull(Me.voucher_id) Then
          If IsNull(DMax("Val(Mid([voucher_id],14))", "voucher", "Left([Voucher_id],12) = '" & strDate & " '")) Then
            Me.voucher_id = strDate & "-" & "01"
            Debug.Print "1"
        Else
            intMax = DMax("Val(Mid([Voucher_Id],14))", "voucher", "Left([Voucher_id],12) = '" & strDate & " '")
            intMax = intMax + 1
            Me.voucher_id = strDate & "-" & Format(intMax, "00")
            Debug.Print "1"
        End If

End If
End Sub

69
ตามความเป็นจริง จำนวนใดๆ หาร 0 มันทำไม่ได้อยู่แล้วครับ

ถ้า จำนวนตัวเลข หาร 0 จะแสดง #Div/0!

ถ้า 0 หาร 0 ก็จะแสดง #Num ครับ

แต่เรากันข้อผิดพลาดได้โดยการกำหนดเงื่อนไข ก่อนคำนวนเช่น
เปลี่ยนจาก [Sum]/[Last]
เป็น
โค๊ด: [Select]
IIf([Sum]<>0 And [last]<>0,[Sum]/[Last],0)
หรือถ้าอยากให้แสดงเป็นช่องว่างแทนเลข 0 ก็ใส่ Null ก็ได้คับ
โค๊ด: [Select]
IIf([Sum]<>0 And [last]<>0,[Sum]/[Last],null)

70
โอ้แย่แล้ว...พอดีเป็นเครื่องที่ทำงาน เค้า Block ไม่ให้ภายนอกเข้ามาได้ครับ....ให้ผมส่งไฟล์ไปให้ หรือ ให้ทำอย่างไรดีครับ....ขอบคุณครับ
แนบไฟล์ส่งมาใน Inbox เลยคับ

71
ธรรมดา มันจะมีให้ติ๊ก business กับ None commer...... ติ๊ก None แล้ว Next ยาวๆ พอติดตั้งเสร็จมันจะมี ID กับ password ของเรา ก็เอารหัสนั้นส่งให้ผมทาง Inbox ครับ

หน้า: 1 2 3 [4] 5 6 7 ... 32