Board logo

標題: 一個表單請求協助 [打印本頁]
作者: 周大偉    時間: 2012-2-12 17:32     標題: 一個表單請求協助

大大們, 小弟有一個表單請求協助, 上傳檔中有說明, 先行謝過大大們,
[attach]9553[/attach]
作者: Hsieh    時間: 2012-2-12 23:06

  1. Private Sub Label1_Click()
  2. Set a = Columns("A:A").Find(TextBox1.Text, lookat:=xlWhole)
  3. If a Is Nothing Then r = [A65536].End(xlUp).Row + 1 Else r = a.Row
  4. For i = 1 To 9
  5.    Cells(r, i) = Controls("TextBox" & i).Text
  6. Next
  7. End Sub

  9. Private Sub Label2_Click()
  10. Set a = Columns("A:A").Find(TextBox1.Text, lookat:=xlWhole)
  11. If a Is Nothing Then r = [A65536].End(xlUp).Row + 1 Else r = a.Row
  12. For i = 1 To 9
  13.    Cells(r, i) = Controls("TextBox" & i).Text
  14. Next

  16. End Sub

  18. Private Sub Label3_Click()
  19. ThisWorkbook.Save
  20. End Sub

  22. Private Sub Label4_Click()
  23. ScrollBar1.Value = Application.Max(ScrollBar1.Value - 1, ScrollBar1.Min)
  24. End Sub

  26. Private Sub Label5_Click()
  27. ScrollBar1.Value = Application.Min(ScrollBar1.Value + 1, ScrollBar1.Max)
  28. If ScrollBar1.Value = ScrollBar1.Max Then ScrollBar1.Max = ScrollBar1.Max + 1
  29. End Sub

  31. Private Sub ScrollBar1_Change()
  32. r = ScrollBar1.Value
  33. For i = 1 To 9
  34. Controls("TextBox" & i) = Cells(r, i).Value
  35. Next
  36. End Sub

  38. Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  39. Set a = Columns("A:A").Find(TextBox1.Text, lookat:=xlWhole)
  40. If Not a Is Nothing Then
  41. MsgBox "學號重複"
  42. With TextBox1
  43. Cancel = True
  44. End With
  45. End If
  46. End Sub

  48. Private Sub UserForm_Initialize()
  49. r = [A65536].End(xlUp).Row
  50. With ScrollBar1
  51. .Min = 3
  52. .Max = r + 1
  53. End With
  54. End Sub
複製代碼
回復 1# 周大偉
作者: 周大偉    時間: 2012-2-12 23:45

b]回復 2# Hsieh

謝謝版大, 衷心感謝, 可以運用, 但修改資料好像不能修改, 另版大, 若增設一刪除按鈕可以麼.
[attach]9560[/attach]
作者: Hsieh    時間: 2012-2-13 00:06

回復 3# 周大偉
增加一個刪除程序
  1. Private Sub Label15_Click()
  2. Set a = Columns("A:A").Find(TextBox1.Text, lookat:=xlWhole)
  3. If Not a Is Nothing Then a.Resize(, 9).Delete xlShiftUp
  4. End Sub
複製代碼
要刪除或修改都請使用上一筆、下一筆或捲軸讓學號為空白後再輸入
作者: 周大偉    時間: 2012-2-13 07:25

回復 4# Hsieh
版大, 早晨
刪除沒有問題, 但修改使用上一筆或下筆捲軸到空白處時, 輸入學號, 該列學號資料清空, 剩下編號, 用家便在空白欄處修改, 但沒法輸入, 必須把該列資料全部刪, 重新輸入,
可否設定, 用家用上一筆或下筆捲軸到空白處時, 按修改, 輸入學號, 該列資料顯示, 用家隨意修改欄位後存檔,
謝過版大
作者: GBKEE    時間: 2012-2-13 13:03

本帖最後由 GBKEE 於 2012-2-13 13:16 編輯

回復 5# 周大偉
系統的的表單
  1. Sub Ex()
  2.     With ActiveSheet
  3.         .UsedRange.Name = "DATABASE"
  4.         If [DATABASE].Rows.Count = 1 Then [DATABASE].Resize(2).Name = "DATABASE"
  5.         .ShowDataForm
  6.     End With
  7.     Names("DATABASE").Delete
  8. End Sub
複製代碼
[attach]9562[/attach]
作者: 周大偉    時間: 2012-2-13 14:10

回復 6# GBKEE
謝謝两位版大回應, 祝願健康, 快樂..
作者: tonycho33    時間: 2012-2-13 15:26

回復 6# GBKEE


請問表單是怎麼設定的
可以教學一下嗎
謝謝
作者: GBKEE    時間: 2012-2-13 16:40

回復 8# tonycho33
1  選定資料範圍內的任一儲存格
2 指令:  工具->資料->表單
3 按下確定
表單就出現
作者: 317    時間: 2012-2-14 13:56

回復 6# GBKEE

版大, 好
加入程式把excel表單叫出, 小妹真是沒有想過, 請教版大, 表單中的字體就可否用程式把其變大...謝謝!!祝快樂..
作者: GBKEE    時間: 2012-2-14 18:10

回復 10# 317
我還找不到如何變大
作者: 317    時間: 2012-2-14 19:02

回復 11# GBKEE
謝謝回應,



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