Page 1 of 1

ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Wed Jun 18, 2014 10:45 pm
by pongpang

Code: Select all

Private Sub CommandButton1_Click()
Dim username As String
Dim password As String
    usernane = TextBox1.Text
    password = TextBox2.Text
    'if textbox1.text="abc" and textbox2.text="123"then
     'msgbox("OK")
Dim info
     info = isworkbookopen("G:\Userform\login.xlsx")
     'we open the work book
 If info = False Then
       Workbooks .Open("G:\Userform\login.xlsx")
End If
Dim x As Integer
     x = 2
     Do While Cells(x, 1).Value <> ""
If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then
     MsgBox "Welcome"
      Sheet1 , Range("A1").Value = Date & " " & Time
      Selection.NumberFormat = "dd/m/YYYY h:mm am/pm"
     UserForm1.Hide
      ActiveWorkbook.Close True
 End
 Else
       x = x + 1
 End If
 
 Loop
      MsgBox "please check your username or password"
       ActiveWorkbook.Close True
       TextBox1.Text = ""
       TextBox2.Text = ""
       TextBox1.SetFocus
 
       'else
      'msgbox "wrong username or password"
       'TextBox1.Text = ""
      'TextBox2.Text = ""
        'TextBox1.SetFocus
      'endif
 
 

End Sub
จะเออเร่อตามภาพนี้
login01.png
และเมื่อปิดไฟล์ ที่Code

Code: Select all

Sub getlogindata()
Dim info
info = isworkbookopen("G:\Userform\login.xlsx")
'we open the workbook if it is close
If info = fasle Then
Workbooks.Open ("G:\Userform\login.xlsx")
End If
Worksheets("sheet1").Activate
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination = Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))

ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Quit

End Sub
จะเกิดดีบักตามภาพ
login02.png
สำหรับไฟล์ที่เกี่ยวข้องแนบมาด้วยแล้ว และส่งมาครั้งเดียวไม่หมดส่งเพิ่มเติมมาอีกครัย

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Wed Jun 18, 2014 10:47 pm
by pongpang
ส่งไฟล์มาเพิ่มจากกระทู้ข้างบนครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 10:29 am
by snasui
:D อ้างถึง Private Sub CommandButton1_Click() จาก Statement Workbooks .Open("G:\Userform\login.xlsx") ให้ปรับเป็น Workbooks.Open("G:\Userform\login.xlsx") สังเกตว่าระหว่าง Workbook กับ .Open ไม่ต้องเว้นวรรค

จาก Statement Sheet1 , Range("A1").Value = Date & " " & Time ให้เปลี่ยนเป็น Sheet1.Range("A1").Value = Date & " " & Time

อ้างถึง Sub getlogindata() จาก Statement ActiveSheet.Paste Destination=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2)) ให้เปลี่ยนเป็น ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 11:15 am
by pongpang
เรียนอาจารย์

ได้ปรับเปลี่ยนแก้Code ตามที่อาจารย์แนะนำแล้วครับ แต่ยังเป็นดีบักที่ Private Sub CommandButton1_Click()
ตามภาพครับ
login03.png

Code: Select all

Private Sub CommandButton1_Click()
Dim username As String
Dim password As String
usernane = TextBox1.Text
password = TextBox2.Text
'if textbox1.text="abc" and textbox2.text="123"then
'msgbox("OK")
Dim info
info = isWorkbooks.Open("G:\Userform\login.xlsx")
'we open the work book
If info = False Then
Workbooks = .Open("G:\Userform\login.xlsx")
End If
Dim x As Integer
x = 2
Do While Cells(x, 1).Value <> ""
If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then
MsgBox "Welcome"
Sheet1 , Range("A1").Value = Date & " " & Time
Selection.NumberFormat = "d/m/YYYY h:mm am/pm"
 UserForm1.Hide
 ActiveWorkbook.Close True
 End
 Else
 x = x + 1
 End If
 
 Loop
 MsgBox "please check your username or password"
 ActiveWorkbook.Close True
 TextBox1.Text = ""
 TextBox2.Text = ""
 TextBox1.SetFocus
 
 'else
 'msgbox "wrong username or password"
 'TextBox1.Text = ""
 'TextBox2.Text = ""
 'TextBox1.SetFocus
 'endif
 
 

End Sub
และเมื่อปิด Private Sub CommandButton2_Click()
จะดีบัก ตามภาพ ครับ
login04.png

Code: Select all

Private Sub CommandButton2_Click()
Sheet1.Range("b1").Value = Date & " " & Time
Selection.NumberFormat = "d/m/yyyy h;mm Am/Pm"
ThisWorkbook.Save
Worksheets("sheet1").Range("A1:b1").Select
Selection.Cut
Unload Me
getlogindata

'Application,displayAlerts = false
ActiveWorkbook.Close True
'Application.Quit
'application.displayalerts = true



End Sub
สำหรับไฟล์ได้แนบมาด้วยแล้วครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 11:19 am
by snasui
:D อ่านที่ผมตอบอย่างละเอียดดูว่าแก้ไขตรงตามที่ผมแจ้งไปแล้วหรือไม่

ตามที่โพสต์มา ไม่ได้แก้ไขตามที่ผมแจ้งไปครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 11:41 am
by pongpang
เรียน อาจารย์
snasui wrote::D อ่านที่ผมตอบอย่างละเอียดดูว่าแก้ไขตรงตามที่ผมแจ้งไปแล้วหรือไม่

ตามที่โพสต์มา ไม่ได้แก้ไขตามที่ผมแจ้งไปครับ
ขอบคุณมากครับที่ได้กรุณา ผมได้ปรับปรุง แต่ที่ Private Sub CommandButton1_Click() เกิดเออเร่อ ตามภาพครับ
login05.png

Code: Select all

Private Sub CommandButton1_Click()
Dim username As String
Dim password As String
usernane = TextBox1.Text
password = TextBox2.Text
'if textbox1.text="abc" and textbox2.text="123"then
'msgbox("OK")
Dim info
info = isWorkbooks.Open("G:\Userform\login.xlsx")
'we open the work book
If info = False Then
Workbooks.Open ("G:\Userform\login.xlsx")
End If
Dim x As Integer
x = 2
Do While Cells(x, 1).Value <> ""
If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then
MsgBox "Welcome"
Sheet1.Range("A1").Value = Date & " " & Time
Selection.NumberFormat = "d/m/YYYY h:mm am/pm"
 UserForm1.Hide
 ActiveWorkbook.Close True
 End
 Else
 x = x + 1
 End If
 
 Loop
 MsgBox "please check your username or password"
 ActiveWorkbook.Close True
 TextBox1.Text = ""
 TextBox2.Text = ""
 TextBox1.SetFocus
 
 'else
 'msgbox "wrong username or password"
 'TextBox1.Text = ""
 'TextBox2.Text = ""
 'TextBox1.SetFocus
 'endif
 
 

End Sub

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 1:39 pm
by snasui
:D เปลี่ยน Code บรรทัดที่ Error กลับไปเป็น info = isworkbookopen("G:\Userform\login.xlsx") ครับ

ควรเปลี่ยนเฉพาะที่ผมแจ้งให้เปลี่ยนเท่านั้น ไม่ใช่เห็นว่าคล้่ายๆ กันก็ทำการเปลี่ยนไปด้วย บรรทัดนี้อยู่ก่อนบรรทัดที่ผมแจ้งให้เปลี่ยนและก่อนหน้านี้ไม่เกิด Error ก็แสดงว่าใช้ได้อยู่แล้วไม่ต้องเปลียนครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 2:36 pm
by pongpang
ขอบคุณครับอาจารย์ Code ของ workbook

Code: Select all

Private Sub Workbook_BeforeClose(Cancel As Boolean)
UserForm1.CommandButton2.Visible = True
UserForm1.CommandButton1.Visible = False
UserForm1.TextBox1.Visible = False
UserForm1.TextBox2.Visible = False
UserForm1.Label1.Visible = False
UserForm1.Label2.Visible = False
UserForm1.Show
End Sub
เกิดปัญหาดังนี้ครับ
login06.png

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 6:29 pm
by snasui
:D ผมลองปิดไฟล์แล้วไม่พบว่าเกิด Error ครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 9:30 pm
by pongpang
เรียน อาจารย์ ครับ
เปิดไฟล์ขึ้นมา เมื่อกรอกusername password คลิก login ทั้งที่ถูกต้องตรงตามกำหนด จะแจ้งว่าไม่ถูกต้อง ตามภาพครับ
login07.png
เมื่อคลิกที่ปุ่ม OK เกิดเออเร่อ และมีuserform logout ตามภาพ
login08.png
เมื่อคลิกที่ ดีบัก จะได้ภาพข้างล่างครับ
login09.png

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Thu Jun 19, 2014 11:40 pm
by snasui
:D อ้างอิงถึง Private Sub CommandButton1_Click() จาก Statement usernane = TextBox1.Text ให้เปลี่ยนเป็น username = TextBox1.Text

จาก Statement If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then เปลี่ยนเป็น If Cells(x, 1).Value = username And CStr(Cells(x, 2).Value) = password Then

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Fri Jun 20, 2014 9:11 am
by pongpang
เรียน อาจารย์ ครับ
ขอบคุณมากครับ ได้แล้วครับ แต่ไฟล์ที่ต้องการให้เปิดยังไม่เปิดและไฟล์ username-password ปิด
ผมจึงเพิ่ม Code ต่อท้าย ดังนี้ ที่ Private Sub CommandButton1_Click() เพิ่มเป็น
Workbooks.Open filename:="G:\UserForm\login.xlsx"
Workbooks("username-password.xlsm").Close
ตามรายละเอียดใน Code ข้างล่าง

Code: Select all

Private Sub CommandButton1_Click()
Dim username As String
Dim password As String
'usernane = TextBox1.Text

'จาก Statement usernane = TextBox1.Text ให้เปลี่ยนเป็น username = TextBox1.Text
username = TextBox1.Text
password = TextBox2.Text
'if textbox1.text="abc" and textbox2.text="123"then
'msgbox("OK")
Dim info
'info = isWorkbooks.Open("G:\Userform\login.xlsx")
info = isworkbookopen("G:\Userform\login.xlsx")
'we open the work book
If info = False Then
Workbooks.Open ("G:\Userform\login.xlsx")
End If
Dim x As Integer
x = 2
Do While Cells(x, 1).Value <> ""
'If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then
'จาก Statement If Cells(x, 1).Value = username And Cells(x, 2).Value = password Then เปลี่ยนเป็น If Cells(x, 1).Value = username And CStr(Cells(x, 2).Value) = password Then
If Cells(x, 1).Value = username And CStr(Cells(x, 2).Value) = password Then
MsgBox "Welcome"
Sheet1.Range("A1").Value = Date & " " & Time
Selection.NumberFormat = "d/m/YYYY h:mm am/pm"
 UserForm1.Hide
 Workbooks.Open filename:="G:\UserForm\login.xlsx"
 Workbooks("username-password.xlsm").Close
 
 End
 Else
 x = x + 1
 End If
 
 Loop
 MsgBox "please check your username or password"
 ActiveWorkbook.Close True
 TextBox1.Text = ""
 TextBox2.Text = ""
 TextBox1.SetFocus
 
 'else
 'msgbox "wrong username or password"
 'TextBox1.Text = ""
 'TextBox2.Text = ""
 'TextBox1.SetFocus
 'endif
 
 

End Sub
จาก Code ข้างบน สิ่งเป็นปัญหา คือ ถ้ากรอก usernameหรือpassword ไม่ถูกต้อง ไฟล์ login ก็เปิด
ความต้องการ คือ ถ้ากรอก username หรือ password ไม่ถูกต้อง ให้ไฟล์ username-password ปิด
และไม่เปิดไฟล์ login ครับ
ขอความกรุณา แนะนำ ปรับปรุง Code ให้ด้วยครับ

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Fri Jun 20, 2014 3:00 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

'Other code
Dim check As Boolean
Do While Cells(x, 1).Value <> ""
    If Cells(x, 1).Value = username And CStr(Cells(x, 2).Value) = password Then
        check = True
        MsgBox "Welcome"
        Sheet1.Range("A1").Value = Date & " " & Time
        Selection.NumberFormat = "d/m/YYYY h:mm am/pm"
        UserForm1.Hide
        Workbooks.Open filename:="G:\UserForm\login.xlsx"
        Workbooks("username-password.xlsm").Close
        Exit Sub
    Else
        x = x + 1
    End If
Loop
If Not check Then
    MsgBox "please check your username or password"
    ActiveWorkbook.Close True
End If
'Other code

Re: ขอความกรุณาแก้Code ที่ Error ด้วยครับ

Posted: Fri Jun 20, 2014 9:11 pm
by pongpang
เรียน อาจารย์ คนควน
ขอบคุณมากครับ ได้ตามความต้องการครับ วันนี้เฝ้าระวังทั้งวัน ไฟฟ้าดับตั้งแต่ 12.00 น.ครับ ไม่สามารถใช้ NET ได้
จึงเข้ามาช้า ขออภัยด้วย