.
( 8).
8
.
CommandBar CommandBars ( ). CommandBars . CommandBars Application ( ). CommandBar CommandBarControls, . Controls CommandBar CommandBarControls, :
- CommandBarButton:
, .
- CommandBarComboBox:
, , .
- CommandBarPopUp:
.
CommandBars ( 9).
9 CommandBar
, , , ( 10).
Workbook_Open, .
Private Sub Workbook_Open()
'
MenuBuilder
'
UserForm4.Show ' UserForm4
End Sub
10
MenuBuilder. UserForm4 ( 11), - CommandButton1_Click.
'UserForm4
Private Sub CommandButton1_Click()
Unload UserForm4
End Sub
 |
|
|
11
MenuBuilder, , .
Private Sub MenuBuilder()
'
' a CommandBar ( )
Dim a As CommandBar
' Add Application
' CommandBars ( ) Add
'!!!, "." ()!!!
|
|
|
Set a = Application.CommandBars.Add(Name:="m", Position:=msoBarTop, MenuBar:=True, Temporary:=True)
' , :
'Name -
'Position - Excel ( )
' MenuBar - (True - , False - )
' Temporary - ,
'( True, , False, )
' . ,
'Application.CommandBars(Name:="m"), Object ()
With a ' Visible
.Visible = True
' ( Controls Command Bars)
With.Controls
'
With.Add(Type:=msoControlPopup)
' ""
.Caption = "" '
With.Controls
With.Add(Type:=msoControlButton)
' " " ""
.Caption = " " '
.OnAction = "NewDoc" ' " " ( Module1)
'.OnAction Controls , , , () ( Controls),
End With
With.Add(Type:=msoControlButton)
' " " ""
.Caption = " " '
.OnAction = "Close1" ' " " ( Module1)
End With
With.Add(Type:=msoControlButton)
' "" ""
.Caption = "" '
.OnAction = "ExitDoc" ' "" ( Module1)
End With
End With
End With
' ""
With.Add(Type:=msoControlPopup)
.Caption = ""
' Controls.Add
With.Controls
With.Add(Type:=msoControlButton)
.Caption = " " ' " "
.OnAction = "Enter" ' ,
End With
With.Add(Type:=msoControlButton)
.Caption = " " ' " "
.OnAction = "Remove" ' " "
End With
With.Add(Type:=msoControlButton)
.Caption = " " ' " "
.OnAction = "Z_b" '
" "
End With
With.Add(Type:=msoControlButton)
.Caption = "" '
.OnAction = "Sort" '
|
|
|
""
End With
With.Add(Type:=msoControlButton)
.Caption = "" ' ""
.OnAction = "Find" ' ""
End With
End With
End With
' ""
With.Add(Type:=msoControlPopup)
.Caption = "" '
With.Controls
' " "
With.Add(Type:=msoControlButton)
.Caption = " "
.OnAction = "AboutProg" ' ,
.Style = msoButtonIconAndCaption '
'
.FaceId = 466 ' 466
End With
End With
End With
End With
End With
End Sub
( 12, 13, 14, 15).
12 13
14 15
. , Excel, .
NewDoc, Module1, UserForm6, .
Public Sub NewDoc()
'
UserForm6.Show
End Sub
'UserForm6
Private Sub CommandButton1_Click()
Dim i As Boolean, a As String, w As Worksheet
i = False
Do
a = CStr(UserForm6.TextBox1)
For Each ws In Worksheets
', , ,
'
If ws.Name = a Or a = "" Then
MsgBox " !", _
vbCritical, "": Exit Sub
Else: i = True: End If
Next
Loop Until i = True
'
'Sheets.Add
Sheets.Add
'
ActiveSheet.Name = a
create
' , Excel
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
UserForm6.TextBox1.SetFocus
End Sub
( 16).
( 17, 18).
. 16 UserForm6
 |
17
18
create, Module1.
Public Sub create()
'
Range("1:1").Select: Selection.Font.FontStyle = "": Range("A1:A1").Select
Worksheets(ActiveSheet.Name).Cells(1, 1) = " "
Worksheets(ActiveSheet.Name).Cells(1, 2) = " "
Worksheets(ActiveSheet.Name).Cells(1, 3) = " "
Worksheets(ActiveSheet.Name).Cells(1, 4) = " "
Worksheets(ActiveSheet.Name).Cells(1, 5) = "- "
Columns("A:A").ColumnWidth = 12: Columns("B:B").ColumnWidth = 27
Columns("C:C").ColumnWidth = 27: Columns("D:D").ColumnWidth = 25
Columns("E:E").ColumnWidth = 24
End Sub
Close1, Module1, .
|
|
|
Public Sub Close1()
' ,
ActiveWindow.SelectedSheets.Delete
End Sub
ExitDoc, Module1, .
Public Sub ExitDoc()
'
Application.Quit
End Sub
.
.
Enter, Module1, UserForm1, .
Public Sub Enter()
'
UserForm1.Show
End Sub
'UserForm1
Private Sub CommandButton1_Click()
Dim i As Integer
'
' IsNumeric ,
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox6.Text = "" Or IsNumeric(TextBox3.Text) = False _
Or IsNumeric(TextBox4.Text) = False Or IsNumeric(TextBox5.Text) = False Then
MsgBox " .", vbApplicationModal, "": TextBox1.SetFocus: Exit Sub
End If
i = Application.CountA(Range("A:A")) + 1
' i
' CountA Application
'"A:A" , A ( ),
' , ,
' Worksheets - Excel,
' , , (, Worksheets(1) Worksheets("1")) ActiveSheet.Name, ,
', ActiveSheet.Name , NewDoc
Worksheets(ActiveSheet.Name).Cells(i, 1) = i - 1
' Cells ,
Worksheets(ActiveSheet.Name).Cells(i, 2) = TextBox1
Worksheets(ActiveSheet.Name).Cells(i, 3) = TextBox2.Text
Worksheets(ActiveSheet.Name).Cells(i, 4) = TextBox6.Text +_ " " + TextBox3.Text + "," + TextBox4.Text
Worksheets(ActiveSheet.Name).Cells(i,5)=CInt(TextBox5.Text)
End Sub
Private Sub CommandButton2_Click()
Unload Me
' TextBox
End Sub
19 UserForm1
20 UserForm1
Remove, Module1, .
Public Sub Remove()
'
Dim a As Integer: Dim i As Integer: Dim k As Integer: Dim p As Integer
' ,
a = Application.ActiveCell.Row
' ,
p = CInt(Worksheets(ActiveSheet.Name).Cells(a, 1))
'
Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65) & "2")
|
|
|
Worksheets(ActiveSheet.Name).Range("A1").Select
' ,
a = p + 1
If a = 1 Then: MsgBox " !", vbCritical, "": Exit Sub
For k = a To Application.CountA(Range("A:A")) '
For i = 2 To 6
Worksheets(ActiveSheet.Name).Cells(k, i) = Worksheets(ActiveSheet.Name).Cells(k + 1, i)
Worksheets(ActiveSheet.Name).Cells(k + 1, i) = ""
Next i
Next k
Worksheets(ActiveSheet.Name).Cells(Application.CountA(Range("A:_A")), 1) = ""
End Sub
Remove 19, 20.
. 21 ,
. 22
.
. 23
Public Sub Z_b()
'
UserForm3.Show
End Sub
'UserForm3
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Or IsNumeric(TextBox2.Text) = False Then
MsgBox " .", vbApplicationModal, "": TextBox1.SetFocus: Exit Sub
End If
If Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5) > 0 Then
' , ( A)
Worksheets(ActiveSheet.Name).Range("A2:" & "E" & _ Application.CountA(Range("A:A"))).Sort _ Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65) & "2")_
Worksheets(ActiveSheet.Name).Range("A1").Select
Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5)_ = Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5) - 1
'
Open "file.txt" For Output As #1
Print #1, TextBox1; Tab; " - "; TextBox2
Close #1
Else: MsgBox " !",, " "
End If
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
, .
. 24 UserForm3
. 25
Sort, Module1, UserForm5, -.
|
. 26 UserForm5 ( ComboBox)
Public Sub Sort()
'
UserForm5.Show
End Sub
'UserForm5
Private Sub CommandButton1_Click()
Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65 + ComboBox1.ListIndex) & "2")
Worksheets(ActiveSheet.Name).Range("A1").Select
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 1 To Application.CountA(Range("1:1"))
' ComboBox1 ( ) Excel
ComboBox1.AddItem Worksheets(ActiveSheet.Name).Cells(1, i)
Next i
ComboBox1.ListIndex = -1
' ListIndex , ComboBox1. -1 , ( , , )
End Sub
, .
Public Sub Find()
'
UserForm2.Show
End Sub
'UserForm2
Private Sub CommandButton1_Click()
Dim i As Integer: Dim j As Integer: Dim n As Integer
Dim flag As Boolean
If TextBox1.Text = "" Then
MsgBox " .", vbApplicationModal, "": TextBox1.SetFocus: Exit Sub
|
|
|
End If
n = 0
' Sort , , , ..
' Worksheets(ActiveSheet.Name)
' A2 E, - , CountA(A:A)
'Key1 - , D2
' , D,
Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range("D2")
' Select A1
Worksheets(ActiveSheet.Name).Range("A1").Select
flag = False
For i = 2 To Application.CountA(Range("A:A"))
For j = 2 To 3
If Worksheets(ActiveSheet.Name).Cells(i, j) = TextBox1.Text Then n = CInt(Worksheets(ActiveSheet.Name).Cells(i, 1)): flag = True: Exit For
Next j
If flag Then Exit For
Next i
If n = 0 Then
MsgBox " !"
Else: MsgBox " : " & n & Chr(13) & Chr(10) & " : " _
& Worksheets(ActiveSheet.Name).Cells(n + 1, 4)
End If
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
. 27 UserForm2
AbouProg UserForm7, .
Public Sub AboutProg()
' " "
UserForm7.Show
End Sub
'UserForm7
. 28 UserForm7
.
