GBKEE

¦^´_ 1# h99949

1. Const ¹w³]·Ó¤ùºô§} = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg"
   
2. Const ¹w³]·Ó¤ù = "d:\·Ó¤ù.gif"
   
3. Private Sub UserForm_Initialize()  '¶}±Òªí³æªì©lµ{¦¡
   
4.     ¤U¸üºô¸ô¹Ï¤ù
   
5.      With Image1
   
6.         .Picture = LoadPicture(¹w³]·Ó¤ù)          '¸ü¤J¹Ï¤ù
   
7.         .PictureSizeMode = fmPictureSizeModeZoom  '¹Ï¤ù¼Ò¦¡
   
8.      End With
   
9.      TextBox1.SetFocus
   
10. End Sub
    
11. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'ªí³æÃö³¬
    
12.     Kill ¹w³]·Ó¤ù '§R°£
    
13. End Sub
    
14. Private Sub TextBox1_Change()
    
15.     If TextBox1.Value = "" Then Exit Sub
    
16.     Dim cell As Range
    
17.     Set cell = Sheets("ÂøµæÁç").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
    
18.     If Not cell Is Nothing Then
    
19.         If Dir("D:\catalogue\" & cell & ".*") <> "" Then
    
20.             Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
    
21.         End If
    
22.         TextBox2.Value = cell.Offset(, 1).Value
    
23.         TextBox3.Value = cell.Offset(, 2).Value
    
24.         TextBox4.Value = cell.Offset(, 3).Value
    
25.         TextBox5.Value = cell.Offset(, 4).Value
    
26.         TextBox6.Value = cell.Offset(, 5).Value
    
27.         TextBox7.Value = cell.Offset(, 32).Value
    
28.         TextBox8.Value = cell.Offset(, 33).Value
    
29.     Else
    
30.        Image1.Picture = LoadPicture(¹w³]·Ó¤ù)
    
31.         TextBox2.Value = ""
    
32.         TextBox3.Value = ""
    
33.         TextBox4.Value = ""
    
34.         TextBox5.Value = ""
    
35.         TextBox6.Value = ""
    
36.         TextBox7.Value = ""
    
37.         TextBox8.Value = ""
    
38.     End If
    
39. End Sub
    
40. Private Sub TextBox1_AfterUpdate()
    
41.     If TextBox2.Value = "" Then
    
42.         TextBox2.SetFocus
    
43.     Else
    
44.         CommandButton2.SetFocus
    
45.     End If
    
46. End Sub
    
47. Private Sub ¤U¸üºô¸ô¹Ï¤ù()
    
48.     Dim xml As Object     '¥Î¨Ó¨ú±oºô­¶¸ê®Æ
    
49.     Dim stream            'As ADODB.stream   '¥Î¨ÓÀx¦s¤G¶i¦ìÀÉ®×
    
50.     Set xml = CreateObject("Microsoft.XMLHTTP")
    
51.     Set stream = CreateObject("ADODB.stream")
    
52.         xml.Open "GET", ¹w³]·Ó¤ùºô§}, 0
    
53.         xml.send
    
54.     With stream
    
55.         .Open
    
56.         .Type = 1
    
57.         .write xml.ResponseBody
    
58.         If Dir(¹w³]·Ó¤ù) <> "" Then Kill ¹w³]·Ó¤ù
    
59.         .SaveToFile (¹w³]·Ó¤ù)
    
60.         .Close
    
61.     End With
    
62.     Set xml = Nothing
    
63.     Set stream = Nothing
    
64. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# h99949
¹Ï¤ù¬O©ñ¦b¹q¸£ªºD:\catalogue¸Ì¨Ã¤£¬Oºô§}¸Ì,½Ð°Ýµ{¦¡¸Ó¦p¦ó­×§ï?
¹Ï¤ù¤£¬O©T©wªº¥¦¬O¥i¥H¨Ì¿é¤Jªº¸ê®Æ¤£¦P§@ÅܤÆ
¥i¥H±N¹w³]ªº·Ó¤ù§ï¦¨¹q¸£¸Ìªº¹Ï¤ù¶Ü?

1. Const ¹w³]·Ó¤ù = "d:\·Ó¤ù.gif"  '³o¤£¬O¹q¸£¸Ìªº¹Ï¤ù¶Ü
   
2. Private Sub TextBox1_Change()
   
3.     If TextBox1.Value = "" Then Exit Sub
   
4.     Dim cell As Range
   
5.     Set cell = Sheets("ÂøµæÁç").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
   
6.     If Not cell Is Nothing Then  
   
7.         If Dir("D:\catalogue\" & cell & ".*") <> "" Then  
   
8.              '*** ¦b¹q¸£ªºD:\ ¤w§ó¥¿ D:\catalogue     ******
   
9.             ' *** ¨Ì TextBox1.Value ¦³ÅÜ¤Æ ******
   
10.             Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
    
11.             'TextBox1.Value-> "d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*")
    
12.         End If
    
13.     Else
    
14.        Image1.Picture = LoadPicture(¹w³]·Ó¤ù)
    
15.      End If

½Æ»s¥N½X

GBKEE

¦^´_ 7# h99949

1. Option Explicit         '±j¨î«Å§iÅܼÆ
   
2. Option Base 1           '°}¦Cªº¯Á¤Þ­È,«ü©w¤U­­­È¬° 1
   
3. Const ¹w³]·Ó¤ùºô§} = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '«ü©w±`¼Æ
   
4. Const ¹w³]·Ó¤ù = "d:\·Ó¤ù.gif"
   
5. Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String
   
6. 
   
7. Private Sub UserForm_Initialize()   '¶}±Òªí³æªì©lµ{¦¡
   
8.     Dim i As Integer
   
9.     For i = 1 To 7
   
10.         ReDim Preserve Text_Ar(1 To i)
    
11.         Set Text_Ar(i) = Me.Controls("TextBox" & i + 1) '±N±±¨î¶µ"TextBox?" ¸m¤J°}¦C¤¤
    
12.     Next
    
13.     AR = Array(1, 2, 3, 4, 5, 32, 33)   '³f¸¹¸ê®Æªº¦ì¸m
    
14.     TextBox1.SetFocus
    
15.     ¤U¸üºô¸ô¹Ï¤ù
    
16.     With Image1
    
17.         .Picture = LoadPicture(¹w³]·Ó¤ù)          '¸ü¤J¹Ï¤ù
    
18.         .PictureSizeMode = fmPictureSizeModeZoom  '¹Ï¤ù¼Ò¦¡
    
19.     End With
    
20. End Sub
    
21. 
    
22. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'ªí³æÃö³¬
    
23.     Kill ¹w³]·Ó¤ù '§R°£
    
24. End Sub
    
25. 
    
26. Private Sub TextBox1_Change()
    
27.     Dim i As Integer
    
28.     If TextBox1.Value = "" Then Exit Sub
    
29.     Set Rng = Sheets("ÂøµæÁç").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
    
30.     If Not Rng Is Nothing Then
    
31.         If Dir("D:\catalogue\" & Rng & ".*") <> "" Then
    
32.            Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & Rng & ".*"))
    
33.         End If
    
34.         Rng_Text = ""                                              '²M°£ °O¾Ð¸ê®Æ
    
35.         For i = 1 To UBound(AR)
    
36.             Rng_Text = Rng_Text & Rng.Offset(, AR(i))   '°O¾Ð¸ê®Æ
    
37.             Text_Ar(i).Text = Rng.Offset(, AR(i)).Value '¾É¤J¸ê®Æ¦bTextBox?
    
38.             'Rng.Offset(, i).Text  :Àx¦s®æÅã¥Üªº¼Æ¦r®æ¦¡
    
39.             'Rng.Offset(, i).Value :Àx¦s®æ¯u¥¿ªº¼Æ¦r
    
40.             'Åã¥Üªº¼Æ¦r®æ¦¡,¤£¤@©wµ¥©ó,¯u¥¿ªº¼Æ¦r.
    
41.         Next
    
42.     Else
    
43.        Image1.Picture = LoadPicture(¹w³]·Ó¤ù)
    
44.         For i = 1 To UBound(AR)
    
45.             Text_Ar(i).Text = ""
    
46.         Next
    
47.     End If
    
48. End Sub
    
49. 
    
50. Private Sub TextBox1_AfterUpdate()
    
51.     If TextBox2.Value = "" Then
    
52.         TextBox2.SetFocus
    
53.     Else
    
54.         CommandButton2.SetFocus
    
55.     End If
    
56. End Sub
    
57. 
    
58. Private Sub CommandButton1_Click()
    
59.     Dim s As String, i As Integer
    
60.     If Rng Is Nothing Then
    
61.         s = "³f¸¹¤¤¨S¦³ " & TextBox1
    
62.     ElseIf Rng_Text = Join(Text_Ar, "") Then
    
63.         s = "³f¸¹" & TextBox1 & "¸ê®Æ¨S¦³­×§ï !!"
    
64.     End If
    
65.     If s = "" Then
    
66.         If MsgBox(TextBox1 & "­×§ï¸ê®Æ !!", 32 + vbYesNo) = vbYes Then
    
67.             For i = 1 To UBound(AR)
    
68.                 Rng.Offset(, AR(i)).Value = Text_Ar(i) '¾É¤JTextBox?¼Æ¦r(¤å¦r«¬ºA)¨ìRng
    
69.                 Rng.EntireRow = Rng.EntireRow.Value '¼Æ¦r(¤å¦r«¬ºA)Âର ¼Æ¦r(¼Æ¦r«¬ºA)
    
70.             Next
    
71.         End If
    
72.     End If
    
73. End Sub
    
74. 
    
75. Private Sub ¤U¸üºô¸ô¹Ï¤ù()
    
76.     Dim xml As Object     '¥Î¨Ó¨ú±oºô­¶¸ê®Æ
    
77.     Dim stream            'As ADODB.stream   '¥Î¨ÓÀx¦s¤G¶i¦ìÀÉ®×
    
78.     Set xml = CreateObject("Microsoft.XMLHTTP")
    
79.     Set stream = CreateObject("ADODB.stream")
    
80.         xml.Open "GET", ¹w³]·Ó¤ùºô§}, 0
    
81.         xml.send
    
82.     With stream
    
83.         .Open
    
84.         .Type = 1
    
85.         .write xml.ResponseBody
    
86.         If Dir(¹w³]·Ó¤ù) <> "" Then Kill ¹w³]·Ó¤ù
    
87.         .SaveToFile (¹w³]·Ó¤ù)
    
88.         .Close
    
89.     End With
    
90.     Set xml = Nothing
    
91.     Set stream = Nothing
    
92. End Sub
    
93. 
    
94. Private Sub cal_Click()
    
95.     Dim x As Integer, y As Integer, s As String
    
96.     x = Val(mypv)                       '³æ»ù
    
97.     y = Val(myrate)
    
98.     If y <> 0 Then s = Round(x / y, 2)  '¶×²v
    
99.     ratepay.Caption = s
    
100. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# h99949

1. Option Explicit         '±j¨î«Å§iÅܼÆ
   
2. Option Base 1           '°}¦Cªº¯Á¤Þ­È,«ü©w¤U­­­È¬° 1
   
3. Const ¹w³]·Ó¤ùºô§} = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '«ü©w±`¼Æ
   
4. Const ¹w³]·Ó¤ù = "d:\·Ó¤ù.gif"
   
5. Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String  '³o¸Ì¦³¶Ü?

½Æ»s¥N½X

GBKEE

¦^´_ 12# h99949
cell §ï¦¨ Rng

GBKEE

¦^´_ 15# h99949

1. Private Sub CommandButton1_Click()
   
2.     Dim s As String, i As Integer
   
3.     If Rng Is Nothing Then
   
4.         s = "³f¸¹¤¤¨S¦³ " & TextBox1
   
5.     ElseIf Rng_Text = Join(Text_Ar, "") Then
   
6.         s = "³f¸¹" & TextBox1 & "¸ê®Æ¨S¦³­×§ï !!"
   
7.     End If
   
8.     If s = "" Then
   
9.         If MsgBox(TextBox1 & "­×§ï¸ê®Æ !!", 32 + vbYesNo) = vbYes Then
   
10.             For i = 1 To UBound(AR)
    
11.                 With Rng.Offset(, AR(i))
    
12.                     .Value = Text_Ar(i) '¾É¤JTextBox?¼Æ¦r(¤å¦r«¬ºA)¨ìRng
    
13.                     .Value = .Value
    
14.                     .NumberFormatLocal = "#,##0.00_ "
    
15.                 End With
    
16.             Next
    
17.         End If
    
18.     End If
    
19. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 18# h99949
§¹¾ãª©ªº¸ê®Æ [·s¼W],[­×¥¿],[§R°£] «öÁä
§ä¤£¸ô®|®É­×§ï  Const ¹w³]·Ó¤ù = "D:\«È¤á³ø»ù³æ\catalogue\GEIST.gif"


Ex.rar (22.53 KB)

¤U¸ü¦¸¼Æ: 9

2014-2-26 14:43

GBKEE

¦^´_ 20# h99949
µLªk³]©wListÄÝ©Ê

1. Private Sub Item_List()   '«Ø¥ßComboBox1ªºList
   
2.     Dim AR
   
3.     Set Sh = Sheets("ÂøµæÁç")
   
4.     With Sh
   
5.         If .Range("a1").End(xlDown).Row = .Rows.Count Then
   
6.             ComboBox1.Clear
   
7.         Else
   
8.             AR = .Range("a2:a" & .Range("a1").End(xlDown).Row).Value
   
9.             If .Range("a1").End(xlDown).Row = 2 Then AR = Array(AR)
   
10.             ComboBox1.List = AR
    
11.         End If
    
12.     End With
    
13. End Sub

½Æ»s¥N½X

°l¥[Äæ¦ì¤u®É=30000*10/20/1000*D/C

1. Option Explicit  'ª«¥ó¼Ò²Õµ{¦¡½X
   
2. Public WithEvents Text_A As MSForms.TextBox
   
3. Public WithEvents Text_B As MSForms.TextBox
   
4. Private Sub Text_A_Change()
   
5.     Dim S As Integer
   
6.     With Text_A
   
7.          With .Parent
   
8.             '°l¥[Äæ¦ì¤u®É = 30000 * 10 / 20 / 1000 * D / C
   
9.             If IsNumeric(.TextBox3) And IsNumeric(.TextBox4) Then
   
10.                
    
11.                 S = CLng(30000) * 10 / 20 / 1000 * .TextBox4 / .TextBox3
    
12.                 .TextBox27 = Application.WorksheetFunction.Round(S, 2)
    
13.             Else
    
14.                 .TextBox27 = ""
    
15.             End If
    
16.         End With
    
17.         '******************************************
    
18.         S = Val(Replace(UCase(.Name), "TEXTBOX", ""))
    
19.         If (IsNumeric(.text) And Val(.text) > 0) Or (.Name = "TextBox2" And Trim(.text) <> "") Then
    
20.             Select Case S
    
21.                 Case 2 To 4
    
22.                      .BackColor = &HE0E0E0
    
23.                 Case Else
    
24.                     .BackColor = vbYellow
    
25.             End Select
    
26.         Else
    
27.             .BackColor = vbRed
    
28.         End If
    
29.         If .Parent.Msg Then .Parent.¨¾§b
    
30.     End With
    
31. End Sub
    
32. Private Sub Text_B_Change()   'Á`»ùªº¥[Á`
    
33.     Dim i As Integer, S
    
34.     With Text_B
    
35.         For i = 8 To 27  '****'°l¥[Äæ¦ì¤u®É
    
36.             If IsNumeric(.Parent.Controls("TextBox" & i)) Or Trim(.Parent.Controls("TextBox" & i)) = "" Then
    
37.                 S = S + Val(.Parent.Controls("TextBox" & i))
    
38.             End If
    
39.         Next
    
40.         .Parent.TextBox7 = IIf(S = 0, "", Int(S))
    
41.         If IsNumeric(.text) Or Trim(.text) = "" Then
    
42.             .BackColor = &HE0E0E0
    
43.         Else
    
44.             .BackColor = vbRed
    
45.         End If
    
46.        If .Parent.Msg Then .Parent.¨¾§b
    
47.     End With
    
48. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 24# h99949
·s¼WITEM ¦³³W«h¶Ü?

GBKEE

¦^´_ 27# h99949

¨S¦³IsText ³o¨ç¼Æ
Trim() :²M°£«e«áªºªÅ¥Õ¦r¦ê
Trim(ComboBox1)<>"" -> ¦³¦r¦ê

1. If IsError(A) And Trim(ComboBox1)<>"" And InStr(AR(1) & ",", ",,") = 0 Then CommandButton1.Enabled = True

½Æ»s¥N½X