返回列表 上一主題 發帖

vba求援

本帖最後由 GBKEE 於 2017-3-12 07:46 編輯

回復 3# sillykin

試試看
  1. Private Sub TextBox3_Change()
  2.     Dim Msg As Boolean
  3.     '基本身分證驗證,
  4.             '1.為要10碼 -> Len(TextBox3) = 10
  5.             '2 第一碼為英文字母後9碼全為數字 ->TextBox3.Text Like "[A-z]#########"
  6.             
  7.    '**** 但實際上政府有身分證的驗證規則 *****
  8.     Msg = Len(TextBox3) = 10 And TextBox3.Text Like "[A-z]#########"   '其中一項不為真 Msg =False
  9.     'Label18.為表單上,統一編號的Label控制項
  10.     Label18.BackColor = IIf(Msg, &HFFFFC0, &HFF&)  '指定物件的背景色彩。
  11.    
  12. End Sub

  13. Private Sub CommandButton2_Click()  '表單上資料輸入,請新增一按鈕,此按鍵紐的程式碼
  14.     Dim Msg As String, Ar(), E As Variant, Rng As Range
  15.     Ar = Array(TextBox2, TextBox3, TextBox4, TextBox5, TextBox6)  '控制項置入陣列
  16.     '********防呆程式碼**********
  17.     Msg = IIf(Label18.BackColor = &HFF&, "統一編號 有錯誤", "")
  18.     For Each E In Ar
  19.         If E = "" Then Msg = Msg & IIf(Msg <> "", vbLf, "") & "資料輸入不齊全": Exit For
  20.     Next
  21.     If Msg <> "" Then MsgBox Msg: Exit Sub
  22.     Set Rng = Range("b50:P50")              '指定的位置
  23.     E = Application.CountA(Rng)             '計算位置中有資料的個數
  24.     '**指定位置,資料位置的檢查
  25.     If E > 0 Then
  26.         If E = Rng.Cells.Count Then MsgBox "資料已滿 ! 請檢查 ": Exit Sub  
  27.         If Rng.Cells(E).Address <> Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub
  28.     End If
  29.    
  30.     '********防呆結束**********
  31.     If MsgBox("確定 輸入資料!", vbYesNo) = vbNo Then Exit Sub
  32.     '******資料輸入*************************************
  33.     With Rng.Offset(0, E)
  34.         .Resize(UBound(Ar) + 1, 1).Value = Application.WorksheetFunction.Transpose(Ar)
  35.     End With
  36. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# sillykin

這行程式碼是錯誤多餘的請刪掉
  1.       If Rng.Cells(Rng.Cells.Count).End(xlToLeft).Address <> Rng.Cells(1).Address Then MsgBox "資料位置有誤 ! 請檢查 ": Exit Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# sillykin


   
  1. Private Sub TextBox3_Change()
  2.     Dim Msg As Boolean
  3.     '基本身分證驗證,
  4.             '1.為要10碼 -> Len(TextBox3) = 10
  5.             '2 第一碼為英文字母後9碼全為數字 ->TextBox3.Text Like "[A-z]#########"
  6.    '**** 但實際上政府有身分證的驗證規則 *****
  7.     Msg = Len(TextBox3) = 10 And TextBox3.Text Like "[A-z]#########"   '其中一項不為真 Msg =False
  8.     'Label18.為表單上,統一編號的Label控制項
  9.     Label18.BackColor = IIf(Msg, &HFFFFC0, &HFF&)  '指定物件的背景色彩。
  10.     If Msg Then 檢查碼
  11. End Sub
  12. Function 檢查碼() As Boolean      '身分證最後一碼檢查
  13.     Dim T As String, I As Integer, S As Long
  14.     T = InStr("ABCDEFGHJKLMNPQRSTUVXYWZIO", Left(TextBox3, 1)) + 9 & Mid(TextBox3, 2, 8)
  15.     For I = 1 To 10
  16.         S = S + Mid(T, I, 1) * Left(11 - I, 1)
  17.     Next I
  18.     T = Right(10 - Right(S, 1), 1)
  19.      ' If T <> Mid(TextBox3, 10, 1) Then MsgBox "身份證字號錯誤!檢查碼:" & T
  20.     Label18.BackColor = IIf(T <> Mid(TextBox3, 10, 1), &HFFFFC0, &HFF&)
  21. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有多少力量就做多少事,不要心存等待,等待才會落空。
返回列表 上一主題