Board logo

標題: [發問] 執行巨集 須輸入密碼,但套在此項程式內會無法判斷物件... [打印本頁]
作者: starry1314    時間: 2015-6-10 17:07     標題: 執行巨集 須輸入密碼,但套在此項程式內會無法判斷物件...

  1. Option Explicit
  2. Dim AR(1 To 2), Sh As Worksheet   '模組 私用變數
  3. Sub auto_open()                   '檔案開啟時一般模組 自動執行的檔案
  4.     Sheets("出餐單").Select
  5.     Dim S As Shape, A(), B(), i As Integer
  6.     Set Sh = Sheets("出餐單")
  7.     For Each S In Sh.Shapes
  8.         If S.Type = msoTextBox Then             '方塊的Type   msoTextBox 值= 17
  9.             S.OnAction = "check"                '指定巨集
  10.             ReDim Preserve A(i)
  11.             ReDim Preserve B(i)
  12.             A(i) = S.Name                       '方塊名稱
  13.             If i = 0 Then
  14.                Set B(i) = Sh.[A100]               '指定儲存格
  15.             Else
  16.                 Set B(i) = B(i - 1).Offset(1)   '指定儲存格
  17.             End If
  18.             i = i + 1
  19.         End If
  20.     Next
  21.     AR(1) = A                                   '指定陣列內容
  22.     AR(2) = B                                   '指定陣列內容

  24. End Sub
複製代碼
  1. Sub check()  '必須是按下方塊執行此程序
  2.     'AUTO_OPEN   '如有錯誤 執行 AUTO_OPEN 一次
  3.     Dim K As String, m As Boolean, i As Integer
  4.     With Sh.Shapes(Application.Caller)
  5.         With .TextFrame
  6.             K = .Characters.Text
  7.             If Left(K, 1) = "X" Then
  8.                 .Characters.Text = "O "
  9.                 m = False
  10.             Else
  11.                 .Characters.Text = "X "
  12.                 m = True
  13.             End If
  14.             .Characters(1, Len(K) + 1).Font.Size = 10
  15.             .Characters(1, 1).Font.Size = 32
  16.         End With
  17.         i = Application.Match(.Name, AR(1), 0) - 1      '取的方塊名稱在AR(1)的索引值
  18.         AR(2)(i).Value = m
  19.         AR(2)(i).Offset(, 1).Value = IIf(CSng(m) = 0, 0, 1)
  20.     End With
  21. End Sub
複製代碼
  1. Sub yy()
  2. Dim pw
  3. pw = InputBox("請輸入密碼: ")
  4. If pw <> "1234" Then
  5. MsgBox "密碼錯誤": Exit Sub
  6. Else
  7. 你的巨集
  8. End If
  9. End Sub
複製代碼
作者: luhpro    時間: 2015-6-13 06:31

starry1314 發表於 2015-6-10 17:07


執行巨集 須輸入密碼...
你可以把 Sub yy 的內容先加到 auto_open 最前面:
Sub auto_open()                   '檔案開啟時一般模組 自動執行的檔案
  Dim pw
  
  pw = InputBox("請輸入密碼: ")
  If pw <> "1234" Then MsgBox "密碼錯誤": Application.Quit ' 密碼錯誤時直接關閉檔案

  Sheets("出餐單").Select
...

至於你說的會無法判斷物件...
看不太出來與加上輸入密碼的程式有什麼關係耶?



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