- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 15
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-12
|
9#
發表於 2014-11-2 22:49
| 只看該作者
本帖最後由 luhpro 於 2014-11-2 22:52 編輯
1.如果我有4個UserForm 都要自動編號，編號都要自動帶出，
我重新製作另外三個表單，但號碼會亂跳，不知錯誤在那，請大大指教﹖
2.我做了4個按鈕點選需要的表單，不要開始excel就自動跳出視窗，
請問大大要如何編寫呢﹖
3.日期顯示可以加上時間嗎﹖
Me.lbl建立日期 = Format(Application.VLookup(Me.cmb編號, Worksheets("工作表1").[編號], 2, 0) , "yyyy/m/d") ...
ann.liu 發表於 2014-10-31 09:36 
我重做了.
1. 刪除 開啟表格 工作表, 刪除其他多的 UserForm, 只保留一個 UserForm 實現相關功能, 保留日後新增工作表的彈性, 只要名稱開頭為 "工作表" 就會自動加入選擇序列, 目前可在 Userform 上直接切換工作表與增號.
2. 啟動 UserForm 按鈕放在上方 功能表區 中 說明 的右邊, 那個按鈕點一下即可開啟 UserForm.
3. 因為你沒有說明日期時間取值的標準,我直接帶入目前時間.
4. 在工作表選單切換時, 各工作表中 B1 的值會帶到 姓名 標題欄, 保留彈性調整顯示的可能性.
5. 新增的工作表須自行輸入 A1,B1,C1 的標題名稱, A2 則輸入新的編號
6. 部分地方可能還有 BUG ,時間不夠來不及一一測試.
ufTar (UserForm)- Private Sub cbSheet_Change()
- Dim bNFind As Boolean
- Dim vA
-
- bNFind = True
- For Each vA In ufTar.cbSheet.List
- If vA = ActiveSheet.Name Then bNFind = False
- Next
- If bNFind Then GetSht
- SetForm
- End Sub
- Private Sub cb輸入2_Click()
- Dim sStr$
-
- sStr = CStr(cbSheet)
- With Sheets(sStr)
- If Application.WorksheetFunction.CountIf(.Range("a:a"), txt編號2) > 0 Then
- MsgBox "編號已存在!", vbCritical, "錯誤"
- Exit Sub
- End If
- With .Range("A65536").End(xlUp)
-
- .Range("A2") = txt編號2
- .Range("B2") = txt姓名1
- .Range("C2") = txt日期1
- iMax(vNo(vSh(sStr))) = iMax(vNo(vSh(sStr))) + 1
- txt編號2.Text = vSh(sStr) & "-" & Right("0000" & iMax(vNo(vSh(sStr))) + 1, 4)
- End With
- End With
- End Sub
- Private Sub txt日期1_Change()
- Dim sStr$
-
- sStr = IIf(Hour(Now) > 12, "下午", "上午")
- txt日期1 = Format(Now, "yyyy/m/d " & sStr & Format(Now, " h:mm"))
- End Sub
- Public Sub UserForm_Initialize()
- Dim sStr$
- Dim vA
-
- GetSht
- sStr = ActiveSheet.Name
- With cbSheet
- .Clear
- For Each vA In vSh
- .AddItem vA
- If vA = sStr Then .Value = sStr
- Next
- If .Value = "" Then
- .ListIndex = 0
- End If
- End With
- SetForm
- End Sub
- Private Sub SetForm()
- Dim sStr$
-
- Application.CommandBars(1).Controls(iBtn).Visible = False
- sStr = CStr(cbSheet)
- Sheets(sStr).Select
- txt編號2.Text = vSh(sStr) & "-" & Right("0000" & iMax(vNo(vSh(sStr))) + 1, 4)
- Label2.Caption = Sheets(sStr).[B1]
- txt日期1 = Format(Now, "yyyy/m/d " & sStr & Format(Now, " h:mm"))
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
- Application.CommandBars(1).Controls(iBtn).Visible = True
- End Sub
- Private Sub Workbook_Open()
- SetButton (False)
- GetSht
- SetButton (True)
- End Sub
- Private Sub SetButton(bSw As Boolean)
- Dim sName$
- Dim bNFind As Boolean
- Dim vC, tcbLdData
-
- sName = "開啟表格"
- If Not bSw Then
- For Each vC In Application.CommandBars(1).Controls
- With vC
- If .Caption = sName Then
- .Visible = False
- iBtn = .Index
- End If
- End With
- Next
- Else
- bNFind = True
- For Each vC In Application.CommandBars(1).Controls
- With vC
- If .Caption = sName Then
- bNFind = False
- .Visible = True
- iBtn = .Index
- End If
- End With
- Next
-
- If bNFind Then
- Set tcbLdData = Application.CommandBars(1).Controls.Add(Type:=msoControlButton)
- With tcbLdData
- .Caption = sName
- .FaceId = 2778
- .OnAction = "ShowForm"
- iBtn = .Index
- End With
- End If
- End If
- End Sub
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
- Application.CommandBars(1).Controls(iBtn).Delete
- End Sub
- Public iMax%(), iBtn%
- Public vNo, vSh
- Option Explicit
- Public Sub ShowForm()
- On Error GoTo ErrShowForm
- With ufTar
- If .Visible = False Then .Show
- End With
-
- On Error GoTo 0
- Exit Sub
- ErrShowForm:
- Select Case Err.Number
-
- Case 424 ' 此處需要物件
- ufTar.Show
-
-
- Case 13 ' 型態不符合
- Set vSh = CreateObject("Scripting.Dictionary")
- Set vNo = CreateObject("Scripting.Dictionary")
- ReDim iMax(0)
-
- Case Else
- On Error GoTo 0
- End Select
- Resume
- End Sub
- Public Sub GetSht()
- Dim iNum%
- Dim lRow&
- Dim sStr$
- Dim bNFind1 As Boolean, bNFind2 As Boolean
- Dim vA, vB
- On Error GoTo ErrGetSht
-
- bNFind2 = False
- For Each vA In Worksheets
- bNFind1 = True
- For Each vB In vSh
- If vB = vA.Name Then
- bNFind1 = False
- Exit For
- End If
- Next
- If bNFind1 Then
- bNFind2 = True
- Exit For
- End If
- Next
-
- If Not bNFind2 Then
- bNFind2 = False
- For Each vA In vSh
- bNFind1 = True
- For Each vB In Worksheets
- If vB.Name = vA Then
- bNFind1 = False
- Exit For
- End If
- Next
- If bNFind1 Then
- bNFind2 = True
- Exit For
- End If
- Next
- End If
-
- If bNFind2 Then
- GoSub SetSel
- End If
- On Error GoTo 0
- Exit Sub
- SetSel:
- Set vSh = CreateObject("Scripting.Dictionary")
- Set vNo = CreateObject("Scripting.Dictionary")
- ReDim iMax(0)
- For Each vA In Worksheets
- With vA
- If .Name Like "工作表*" Then
- If .[A2] = "" Then .[A2] = "xxx-0001"
- sStr = Left(.[A2], InStrRev(.[A2], "-") - 1)
- vSh(CStr(.Name)) = sStr
- ReDim Preserve iMax(UBound(iMax, 1) + 1)
- iMax(UBound(iMax, 1)) = 0
- vNo(sStr) = UBound(iMax, 1)
-
- lRow = 2
- Do While .Cells(lRow, 1) <> ""
- sStr = .Cells(lRow, 1)
- iNum = Val(Mid(sStr, InStrRev(sStr, "-") + 1))
- If iNum >= iMax(UBound(iMax, 1)) Then iMax(UBound(iMax, 1)) = iNum
- lRow = lRow + 1
- Loop
- End If
- End With
- Next
- Return
- ErrGetSht:
- Select Case Err.Number
-
- Case 424 ' 此處需要物件
- Set vSh = CreateObject("Scripting.Dictionary")
- Set vNo = CreateObject("Scripting.Dictionary")
- ReDim iMax(0)
-
- Case 13 ' 型態不符合
- Set vSh = CreateObject("Scripting.Dictionary")
- Set vNo = CreateObject("Scripting.Dictionary")
- ReDim iMax(0)
-
- Case Else
- On Error GoTo 0
- End Select
- Resume
- End Sub
 TEXT-a.zip (25.55 KB)
|
|
發表於 2014-10-29 08:51
| 