Класс Functions Здесь расположены универсальные функции которые не отн

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
'Класс Functions. Здесь расположены универсальные функции, которые не относятся к заданию
Option Explicit
'функция считает количество строк в таблице
Public Function countRows(ByVal ws As Worksheet) As Integer
countRows = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
End Function
'функция считает количество колонок в таблице
Public Function countColumns(ByVal ws As Worksheet) As Integer
countColumns = ws.Cells.SpecialCells(xlLastCell).Column
End Function
'фукнция выполняет подгон ширины колонок под размер контента в них
Public Function wsAutoFit(ByRef ws As Worksheet)
ws.UsedRange.Columns.AutoFit
End Function
'функция проверяет наличие листа в заданой книге
Public Function shExist(ByRef sName As String, Optional ByVal wb As Workbook = Nothing) As Boolean
If (wb Is Nothing) Then Set wb = ThisWorkbook
Dim wsSh As Worksheet
On Error Resume Next
Set wsSh = wb.Sheets(sName)
shExist = Not wsSh Is Nothing
End Function
'функция создает новый лист с заданным названием для заданной книги
Public Function createNewWs(ByVal name As String, Optional ByVal wb As Workbook = Nothing) As Worksheet
If (wb Is Nothing) Then Set wb = ThisWorkbook
Set createNewWs = wb.Sheets.Add(, wb.Sheets(wb.Sheets.Count))
createNewWs.name = name
End Function
'функция создает новый лист с заданным названием для заданной книги, при этом удаляет уже существующий лист
Public Function createWsWithCheck(ByVal name As String, Optional ByVal wb As Workbook = Nothing) As Worksheet
If (wb Is Nothing) Then Set wb = ThisWorkbook
If shExist(name, wb) Then
deleteSheetWithoutAsking name
End If
Set createWsWithCheck = wb.Sheets.Add(, wb.Sheets(wb.Sheets.Count))
createWsWithCheck.name = name
End Function
'проверяет, открыта ли книга с заданным названием
Public Function wbIsOpen(ByRef name As String) As Boolean
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks(name)
wbIsOpen = Not wb Is Nothing
End Function
'удаление объекта без оповещения для пользователя
Public Sub deleteWithoutAsking(ByRef obj As Variant)
Dim b As Boolean
b = Application.DisplayAlerts
Application.DisplayAlerts = False
obj.Delete
Application.DisplayAlerts = b
End Sub
'удаляет лист без оповещения пользователя
Public Sub deleteSheetWithoutAsking(ByVal name As String, Optional ByVal wb As Workbook = Nothing)
If (wb Is Nothing) Then Set wb = ThisWorkbook
Dim b As Boolean
b = Application.DisplayAlerts
Application.DisplayAlerts = False
wb.Sheets(name).Delete
Application.DisplayAlerts = b
End Sub
'функция создает новую книгу
Public Function getNewWb(Optional ByVal sheetscnt As Integer = 1) As Workbook
Dim tmpint As Integer
tmpint = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = sheetscnt
Set getNewWb = Workbooks.Add()
Application.SheetsInNewWorkbook = tmpint
End Function
'сохранить книгу с заданым именем в заданой директории
Public Function saveAs(wb As Workbook, ByVal path As String, ByVal filename As String)
wb.saveAs path & "\" & filename
End Function
'открыть базу данных
Public Function openDataWb() As Workbook
Dim consts As Constants
Set consts = New Constants
If wbIsOpen(consts.wbDataName()) Then 'если книга не открыта, прописываем путь
Set openDataWb = Workbooks(consts.wbDataName)
Exit Function
Else
Dim path As String
path = consts.wbDataPath & consts.wbDataName
Workbooks.Open filename:=path
If wbIsOpen(consts.wbDataName) Then
Set openDataWb = Workbooks(consts.wbDataName)
Else
MsgBox "Файл не существует"
End If
End If
End Function
'ускорить работу макроса
Sub speedUp(ByVal flag As Boolean) 'подпрограмма Sub
Application.ScreenUpdating = Not flag 'отключает перерисовку
Application.EnableEvents = Not flag 'отключает любые события у книги (щелчки мышкой, нажатия на клавиатуру)
ActiveSheet.DisplayPageBreaks = Not flag 'отключает разбиение страниц
Application.DisplayStatusBar = Not flag 'отключает статус панель
Application.DisplayAlerts = Not flag 'отключает все диалоговые окна
If flag Then
Application.Calculation = xlCalculationManual 'отключает вычисления в ячейках
Else
Application.Calculation = xlCalculationAutomatic
End If
End Sub