Board logo

標題: [發問] 無法產生inputbox [打印本頁]
作者: henry860608    時間: 2020-8-6 00:19     標題: 無法產生inputbox

本帖最後由 henry860608 於 2020-8-6 00:32 編輯

1.檔案中有4個工作表，分別為工作表1~4，工作表3有程式碼(使用者須輸入密碼)，但是從工作表1切換過去到工作表3，程式碼先檢查權限，不足則輸入密碼。但是密碼的視窗無法產生，而會使檔案當掉，請問有方法解決嗎?
2.附件與代碼如下。
  1. Public Function InputBoxEr(Sht As Integer, iRow As Integer, Optional AddStr) As String

  3.     Dim Prompt As String, Title As String, Default As String, HelpFile As String, Context As String, Hack As String, tmp As String
  4.     Dim Xpos As Double, Ypos As Double
  5.     Dim i As Integer, Count As Integer, RoleSet As Integer, LmtCnt As Integer, Delay As Integer, min As Integer, sec As Integer
  6.     Dim StartRecTime As Date, EndtRecTime As Date, StartTime As Date, EndTime As Date
  7.    
  8.    
  9.    

  11.     With Sheets(Sht)
  12.         
  13.         Prompt = .Cells(iRow, 1)
  14.         Title = .Cells(iRow, 2)
  15.         Default = .Cells(iRow, 3)
  16.         Xpos = .Cells(iRow, 4)
  17.         Ypos = .Cells(iRow, 5)
  18.         HelpFile = .Cells(iRow, 6)
  19.         Context = .Cells(iRow, 7)
  20.         Hack = .Cells(iRow, 8)
  21.         RoleSet = .Cells(iRow, 10)
  22.         LmtCnt = .Cells(iRow, 11)
  23.         Delay = .Cells(iRow, 12)
  24.         StartRecTime = .Cells(iRow, 13)
  25.         EndtRecTime = .Cells(iRow, 14)
  26.         StartTime = .Cells(iRow, 15)
  27.         EndTime = .Cells(iRow, 16)
  28.         Count = .Cells(iRow, 8)

  30.         If RoleSet >= 0 Then
  31.         Else
  32.             MsgBox "錯誤!": Exit Function
  33.         End If
  34.         If (LmtCnt > 0 And Delay > 0) Or (LmtCnt = 0 And Delay = 0) Then
  35.         Else
  36.             MsgBox "錯誤!": Exit Function
  37.         End If
  38.         If RoleSet > Sheets(2).Cells(4, 3) Then
  39.             MsgBox "權限不足": Exit Function
  40.         ElseIf EndtRecTime > Now() Then
  41.             min = Int((Now() - EndtRecTime) / 24 / 60): sec = Int((Now() - EndtRecTime) / 24 / 60 / 60)
  42.             MsgBox "已在 " & Delay & " 分鐘內嘗試操作 " & LmtCnt & " 次，請於" & EndtRecTime & "後嘗試，剩下" & min & "分" & sec & "秒": Exit Function
  43.         ElseIf StartTime > Now() And Not (IsEmpty(StartTime)) Then
  44.             MsgBox "系統目前尚未開放！": Exit Function
  45.         ElseIf EndTime < Now() And Not (IsEmpty(EndTime)) Then
  46.             MsgBox "系統目前已關閉！": Exit Function
  47.         Else
  48.             .Cells(iRow, 13) = Now(): .Cells(iRow, 14) = .Cells(iRow, 13) + LmtCnt / 24 / 60
  49.         End If
  50.         If Count = 0 And EndtRecTime <= Now() Then
  51.             .Cells(iRow, 17) = 1
  52.         Else
  53.             .Cells(iRow, 17) = .Cells(iRow, 17) + 1
  54.         End If
  55.         If IsEmpty(Hack) Then
  56.             'If Xpos = 0 Or Ypos = 0 Then
  57.             '    InputBoxEr = InputBox(Prompt, Title, Default, , , HelpFile, Context)
  58.             'Else
  59.                 InputBoxEr = InputBox(Prompt, Title, Default, Xpos, Ypos, HelpFile, Context)
  60.             'End If
  61.         Else
  62.                 tmp = Sheets(2).Cells(5, 3): Sheets(2).Cells(5, 3) = Hack
  63.             'If Xpos = 0 Or Ypos = 0 Then
  64.             '    InputBoxEr = InputBoxDK(Prompt, Title, Default, , , HelpFile, Context)
  65.             'Else
  66.                 InputBoxEr = InputBoxDK(Prompt, Title, Default, Xpos, Ypos, HelpFile, Context)
  67.             'End If
  68.         End If
  69.             
  70.     End With
  71.     Sheets(2).Cells(5, 3) = tmp
  72. End Function
複製代碼
[attach]32376[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)