'''
' Объявление глобальных переменных
'''
Public clientInfoSaleList As Worksheet
Public clientInfoTrList As Worksheet
Public clientList As Worksheet
Function CreateStuff(path As String, ByVal mnlist As Worksheet)
'''
' Функция, которая собирает информацию о товаре из файлов в папке доставка
'''
Dim Name As String
Dim fullPath As String
Name = Dir(path & "*.xls")
globalCount = 1
Do While Name <> ""
fullPath = path + Name
Application.Workbooks.Open fullPath
Name = Dir
Set currWorkbook = ActiveWorkbook
Set List = currWorkbook.Sheets(1)
' Заполнение столбцов информацией о товаре
For i = 3 To List.Cells(1, 1).CurrentRegion.Rows.Count
mnlist.Cells(globalCount, 1) = List.Cells(i, 1)
mnlist.Cells(globalCount, 2) = List.Cells(i, 2)
mnlist.Cells(globalCount, 3) = List.Cells(i, 3)
mnlist.Cells(globalCount, 4) = List.Cells(i, 4)
globalCount = globalCount + 1
Next
currWorkbook.Close
Loop
End Function
Function CreateClient(path As String, ByVal mnlist As Worksheet, ByVal clientList As Worksheet)
'''
' Функция, которая собирает информацию о товаре из файлов в папке продажа
'''
Dim Name As String
Dim fullPath As String ' путь к папке
Dim clientName() As String ' массив в котором хранится информация об имени клиента
Dim substractedClientName As String
clientCount = 1
Name = Dir(path & "*.xls") ' указание определенного формата
globalCount = 1
Do While Name <> ""
fullPath = path + Name
Application.Workbooks.Open fullPath
Name = Dir
Set currWorkbook = ActiveWorkbook
Set List = currWorkbook.Sheets(1)
clientName = Split(List.Cells(2, 2))
substractedClientName = clientName(1)
'
' Создание листа с именнами клиентов (список содержит совпадающие значения)
clientList.Cells(clientCount, 1) = substractedClientName
clientCount = clientCount + 1
' Заполнение столбцов информацией о товаре
For i = 3 To List.Cells(1, 1).CurrentRegion.Rows.Count
mnlist.Cells(globalCount, 1) = List.Cells(i, 1)
mnlist.Cells(globalCount, 2) = List.Cells(i, 2)
mnlist.Cells(globalCount, 3) = List.Cells(i, 3)
mnlist.Cells(globalCount, 4) = List.Cells(i, 4)
mnlist.Cells(globalCount, 5) = substractedClientName
globalCount = globalCount + 1
Next
currWorkbook.Close
Loop
'
'Фильтрование списка клиентов по уникальному значению
clientList.Cells(1, 1).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=clientList.Cells(1, 3), Unique:=True
End Function
Private Sub ChooseClient_Click()
'''
' Кнопка по выбору клиента
'''
UserForm1.ListBox3.Clear
UserForm1.l_client.Visible = False
UserForm1.l_stuff.Visible = True
UserForm1.rub.Visible = True
UserForm1.ed.Visible = False
UserForm1.kol.Visible = True
UserForm1.all_sum.Visible = False
UserForm1.sum.Visible = True
Dim Client As String
Dim r As Integer
Client = UserForm1.ListBox1.Value
r_rows = 0
Set activelist = ActiveWorkbook.Sheets("Sale")
r = activelist.Cells(1, 1).CurrentRegion.Rows.Count
'
'Заполение ListBox информацией о товаре с листа с назнванием Sale
For i = 1 To r
If Client = activelist.Cells(i, 5) Then
ListBox3.AddItem
ListBox3.List(r_rows, 0) = activelist.Cells(i, 2)
ListBox3.List(r_rows, 1) = " " & activelist.Cells(i, 3)
ListBox3.List(r_rows, 2) = " " & activelist.Cells(i, 4)
ListBox3.List(r_rows, 3) = " " & activelist.Cells(i, 4) * activelist.Cells(i, 3)
r_rows = r_rows + 1
End If
Next
End Sub
Private Sub addInfo_Click()
'''
' Кнопка, которая приводит в действие функции по сбору информации с последующим созданием листов, в которых хранится собранная информация
' Данную кнопку необходимо использовать только при первом запуске программы (если не существует листов "Sale", "Transfer", "Clients"), при последующих запусках приложения, ее использывать не надо
'''
If ActiveWorkbook.Sheets("Sale") = True & ActiveWorkbook.Sheets("Transfer") = True & ActiveWorkbook.Sheets("Clients") = True Then
UserForm1.addInfo.Visible = False
Else
UserForm1.addInfo.Visible = True
End If
Set namelist = ActiveWorkbook.Sheets("Список")
path_work = ActiveWorkbook.path
Set clientInfoSaleList = ActiveWorkbook.Sheets.Add
Set clientInfoTrList = ActiveWorkbook.Sheets.Add
Set clientList = ActiveWorkbook.Sheets.Add
clientList.Name = "Clients"
clientInfoSaleList.Name = "Sale"
clientInfoTrList.Name = "Transfer"
'
'Создание лиcтов "Sale" и "Clients", и заполение их информацией соответственно
CreateClient path_work & "\Продажи\", clientInfoSaleList, clientList
'
'Создание лиcтов "Transfer", и заполение его информацией
CreateStuff path_work & "\Доставка\", clientInfoTrList
'
'Заполение ListBox-ов именами клиентов и названием товара
r = clientList.Cells(1, 1).CurrentRegion.Rows.Count
For i = 1 To r
ListBox1.AddItem clientList.Cells(i, 3)
Next
r2 = namelist.Cells(1, 1).CurrentRegion.Rows.Count
For i = 3 To r2
ListBox2.AddItem namelist.Cells(i, 2)
Next
End Sub
Private Sub ChooseStuff_Click()
'''
' Кнопка по выбору товара
'''
UserForm1.ListBox3.Clear
UserForm1.l_stuff.Visible = False
UserForm1.l_client.Visible = True
UserForm1.rub.Visible = True
UserForm1.kol.Visible = False
UserForm1.ed.Visible = True
UserForm1.sum.Visible = False
UserForm1.all_sum.Visible = True
Dim Stuff As String
Dim r As Integer
Stuff = UserForm1.ListBox2.Value
r_rows = 0
Set activelistTR = ActiveWorkbook.Sheets("Transfer")
r = activelistTR.Cells(1, 2).CurrentRegion.Rows.Count
'
'Заполение ListBox информацией о товаре с листа с назнванием "Transfer"
For i = 1 To r
If Stuff = activelistTR.Cells(i, 2) Then
ListBox3.AddItem
ListBox3.List(r_rows, 0) = activelistTR.Cells(i, 2)
ListBox3.List(r_rows, 1) = " " & activelistTR.Cells(i, 3)
ListBox3.List(r_rows, 2) = " " & activelistTR.Cells(i, 4)
ListBox3.List(r_rows, 3) = " " & activelistTR.Cells(i, 3) * activelistTR.Cells(i, 4)
r_rows = r_rows + 1
End If
Next
End Sub
Private Sub Client_Click()
'''
' Кнопка для заполение листбокса с именами клиентов, при последующих запусках приложения
'''
Dim i As Long
Dim r As Integer
Set namebook = ActiveWorkbook
Set namelist = namebook.Sheets("Clients")
r = namelist.Cells(1, 3).CurrentRegion.Rows.Count
For i = 1 To r
ListBox1.AddItem namelist.Cells(i, 3)
Next
End Sub
Private Sub CommandButton4_Click()
UserForm1.Hide ' закрытие приложения
End Sub
Private Sub Stuff_Click()
'''
' Кнопка для заполение листбокса с названием товара, при последующих запусках приложения
'''
Dim i As Long
Dim r As Integer
Set namelist = ActiveWorkbook.Sheets("Список")
r = namelist.Cells(1, 1).CurrentRegion.Rows.Count
For i = 3 To r
ListBox2.AddItem namelist.Cells(i, 2)
Next
End Sub
Private Sub UserForm_Click()
End Sub