- •Институт итасу
- •Информация о запросах из стран: {список стран}
- •Листинг программы
- •Microsoft Excel Objects
- •ЭтаКнига
- •FrmЗапросы
- •FrmОПрограмме
- •Modules
- •Module1
- •Сохранение
- •Существование
- •План тестированияпрограммы
- •4. Придуманное мной задание
- •Информация о призёрах Олимпийских игр: {Место проведения}
Forms
FrmЗапросы
Option Base 1
Private Sub UserForm_Initialize()
Dim Месяц(2) As String
Месяц(1) = "Апрель"
Месяц(2) = "Март"
frmЗапросы.cboМесяц.List = Месяц
End Sub
Private Sub cboМесяц_Change()
ВыбранныйМесяц = frmЗапросы.cboМесяц.Value
Call СуществованиеФайла(ВыбранныйМесяц)
Call ЗаполнениеСтраны(ВыбранныйМесяц)
End Sub
Sub ЗаполнениеСтраны(ВыбранныйМесяц)
Dim Страны() As String
Dim Страна As String
Dim НомерСтроки As Integer
Dim КолСтран, k, i, j As Integer
Workbooks(ВыбранныйМесяц).Activate
ReDim Preserve Страны(1) As String
КолСтран = 0
For z = 1 To Worksheets.Count
Sheets(z).Activate
НомерСтроки = 2
While Trim(Cells(НомерСтроки, 1).Value) <> ""
Страна = Trim(Cells(НомерСтроки, 3).Value)
For j = 1 To КолСтран
If Страна = Страны(j) Then GoTo a1
Next j
КолСтран = КолСтран + 1
ReDim Preserve Страны(КолСтран) As String
Страны(КолСтран) = Trim(Cells(НомерСтроки, 3).Value)
a1: НомерСтроки = НомерСтроки + 1
Wend
Next z
For i = 1 To КолСтран - 1
Страна = Страны(i)
k = i
For j = i + 1 To КолСтран
If Страны(j) >= Страна Then
Else
Страна = Страны(j)
Страны(j) = Страны(k)
Страны(k) = Страна
End If
Next
Next i
Worksheets(1).Select
Range("A1").Select
frmЗапросы.lstСтраны.List = Страны
frmЗапросы.lstСтраны.MultiSelect = fmMultiSelectMulti
frmЗапросы.lstСтраны.Selected(0) = True
End Sub
Sub cmdОК_Click()
Dim ВыбранныйМесяц As String
Dim ВыбранныеСтраны() As String
Dim КолСтран, НачалоСтраны As Integer
ВыбранныйМесяц = frmЗапросы.cboМесяц.Value
For i = 0 To lstСтраны.ListCount - 1
If lstСтраны.Selected(i) = True Then
КолСтран = КолСтран + 1
For t = 1 To КолСтран
ReDim Preserve ВыбранныеСтраны(КолСтран) _
As String
ВыбранныеСтраны(КолСтран) = _
frmЗапросы.lstСтраны.List(i)
Next t
End If
Next i
If КолСтран = 0 Then
Unload frmЗапросы
MsgBox "Ни одна страна не выбрана!", vbInformation
End
End If
Unload frmЗапросы
Call СохранениеФайла(ВыбранныйМесяц, КолСтран)
НомерСтроки = 2
НачалоСтраны = 3
For i = 1 To КолСтран
Страна = ВыбранныеСтраны(i)
Workbooks("Страны.xls").Activate
While Trim(Cells(НачалоСтраны, 1).Value) <> ""
НачалоСтраны = НачалоСтраны + 1
Wend
Call ЗаполнениеТаблицы(Страна, ВыбранныйМесяц, НачалоСтраны)
НачалоСтраны = НачалоСтраны + 1
Next i
Call ОформлениеПослСтр
Range("A1").Select
ActiveWorkbook.Save
MsgBox "Операция завершена!", vbInformation
End Sub
Sub cmdОтмена_Click()
Unload Me
End Sub
FrmОПрограмме
Private Sub cmdOK_Click()
Unload Me
End Sub
Modules
Module1
Sub ФормаЗапросы()
frmЗапросы.Show
End Sub
Sub ФормаОПрограмме()
frmОПрограмме.Show
End Sub
Сохранение
Option Base 1
Dim НачалоОформления As Integer
Dim КолЗапрВыбрСтраны As Integer
Sub СохранениеФайла(ВыбранныйМесяц, КолСтран)
Dim Path, Папка, Путь As String
Dim i As Integer
Path = "F:\Запросы\" & ВыбранныйМесяц
Папка = Dir(Path, vbDirectory)
If Папка = "" Then
MkDir (Path)
End If
For i = 1 To Workbooks.Count
If Workbooks(i).Name = "Страны.xls" Then
Workbooks(i).Close SaveChanges:=False
Exit For
End If
Next
Путь = "F:\Запросы\" & ВыбранныйМесяц & "\Страны.xls"
If Dir(Путь) = "" Then
Листов = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveSheet.Name = Date
ActiveWorkbook.SaveAs Filename:=Путь
Else
Кнопка = MsgBox("Файл " & Filename & " уже существует. _
Заменить его?", vbYesNo + vbQuestion + vbDefaulfButton1)
Select Case Кнопка
Case vbYes
For i = 1 To Workbooks.Count
If Workbooks(i).Name = "Страны.xls" Then
Workbooks("Страны.xls").Close _
SaveChanges:=False
Exit For
End If
Next i
Kill Путь
Листов = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveSheet.Name = Date
ActiveWorkbook.SaveAs Filename:=Путь
Case vbNo
End
End Select
End If
Application.SheetsInNewWorkbook = Листов
End Sub
Sub ЗаполнениеТаблицы(Страна, ВыбранныйМесяц, НачалоСтраны)
Dim Запросы() As String
Dim КолЗапрВыбрСтраны As String
Dim z, i, k, НомерСтроки, Сумма, Сумма2 As Integer
Call СозданиеШапки
КолЗапрВыбрСтраны = 0
Сумма = 0
Сумма2 = 0
Call СуществованиеФайла(ВыбранныйМесяц)
For z = 1 To Worksheets.Count
Workbooks(ВыбранныйМесяц).Worksheets(z).Activate
НомерСтроки = 2
ЧислоОфСтр = 0
While Trim(Cells(НомерСтроки, 1).Value) <> ""
If Trim(Cells(НомерСтроки, 3).Value) = Страна Then
КолЗапрВыбрСтраны = КолЗапрВыбрСтраны + 1
ЧислоОфСтр = ЧислоОфСтр + 1
ReDim Preserve Запросы(7, КолЗапрВыбрСтраны)
Запросы(1, КолЗапрВыбрСтраны) = _
Worksheets(z).Name
Запросы(2, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 1).Value
Запросы(3, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 2).Value
Запросы(4, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 3).Value
Запросы(5, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 4).Value
Запросы(6, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 5).Value
Запросы(7, КолЗапрВыбрСтраны) = _
Cells(НомерСтроки, 6).Value
End If
НомерСтроки = НомерСтроки + 1
Wend
Workbooks("Страны.xls").Activate
For i = 1 To КолЗапрВыбрСтраны
Cells(i + НачалоСтраны - 1, 1).Value = Запросы(1, i)
Cells(i + НачалоСтраны - 1, 2).Value = Запросы(2, i)
Cells(i + НачалоСтраны - 1, 3).Value = Запросы(3, i)
Cells(i + НачалоСтраны - 1, 4).Value = Запросы(4, i)
Cells(i + НачалоСтраны - 1, 5).Value = Запросы(5, i)
Cells(i + НачалоСтраны - 1, 6).Value = Запросы(6, i)
Cells(i + НачалоСтраны - 1, 7).Value = Запросы(7, i)
Next i
If ЧислоОфСтр <> 0 Then
Call ОформлениеСформированнойТаблицы(ЧислоОфСтр, _
Страна)
End If
Next
Range(Cells(НачалоСтраны, 1), Cells(НачалоСтраны + КолЗапрВыбрСтраны - 1, 7)).Select
Selection.Sort Key1:=Cells(НачалоСтраны, 1), Order1:= _
xlAscending, Header:=xlGuess, Key2:=Cells(НачалоСтраны, 5), _
Order1:=xlAscending, Header:=xlGuess
For k = 1 To КолЗапрВыбрСтраны
Сумма = Сумма + Cells(k + НачалоСтраны - 1, 6).Value
Сумма2 = Сумма2 + Cells(k + НачалоСтраны - 1, 7).Value
Next
Call ОформлениеИтого(Страна, Сумма, Сумма2)
End Sub
Sub ОформлениеСформированнойТаблицы(ЧислоОфСтр, Страна)
НачалоОформления = 2
While Trim(Cells(НачалоОформления, 1)) <> ""
НачалоОформления = НачалоОформления + 1
Wend
Range(Cells(НачалоОформления - ЧислоОфСтр, 1), _
Cells(НачалоОформления - 1, 7)).Select
With Selection.Font
.Name = "Calibri"
.Size = 10
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.ColorIndex = 1
End With
If ЧислоОфСтр > 1 Then
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
End If
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
Range(Cells(НачалоОформления - ЧислоОфСтр, 3), _
Cells(НачалоОформления - 1, 3)).Select
Selection.NumberFormat = "m/d/yyyy"
End Sub
Sub СозданиеШапки()
Range("A1:G1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = "Информация о запросах из стран"
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 12
End With
Range("A2") = "Сайт"
Range("B2") = "Текст запроса"
Range("C2") = "Дата запроса"
Range("D2") = "Страна"
Range("E2") = "Поисковая система"
Range("F2") = "Время на сайте, мин"
Range("G2") = "Количество посещённых страниц"
Range("A2:G2").Select
With Selection.Font
.Name = "Calibri"
.Size = 12
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
Columns("C:C").ColumnWidth = 10
Columns("D:D").ColumnWidth = 11
Columns("E:E").ColumnWidth = 11
Columns("F:F").ColumnWidth = 9
Columns("G:G").ColumnWidth = 13
End Sub
Sub ОформлениеИтого(Страна, Сумма, Сумма2)
НачалоИтого = 2
While Trim(Cells(НачалоИтого, 1)) <> ""
НачалоИтого = НачалоИтого + 1
Wend
Range(Cells(НачалоИтого, 1), Cells(НачалоИтого, 5)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = "Итого по " & Страна & ":"
Range(Cells(НачалоИтого, 1), Cells(НачалоИтого, 7)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 12
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
Cells(НачалоИтого, 6).Value = Сумма
Cells(НачалоИтого, 7).Value = Сумма2
End Sub
Sub ОформлениеПослСтр()
ПослСтр = 2
While Trim(Cells(ПослСтр, 1)) <> ""
ПослСтр = ПослСтр + 1
Wend
Range(Cells(ПослСтр - 1, 1), Cells(ПослСтр - 1, 7)).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 1
End With
End Sub