Option Explicit

Private Declare PtrSafe Function Shell_NotifyIconW Lib "shell32.dll" (ByVal dwMessage As Long, ByRef nfIconData As NOTIFYICONDATAW) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type NOTIFYICONDATAW
  cbSize As Long
#If Win64 Then
  padding1 As Long
#End If
  hwnd As LongPtr
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
#If Win64 Then
  padding2 As Long
#End If
  hIcon As LongPtr
  szTip(1 To 128 * 2) As Byte
  dwState As Long
  dwStateMask As Long
  szInfo(1 To 256 * 2) As Byte
  uTimeout As Long
  szInfoTitle(1 To 64 * 2) As Byte
  dwInfoFlags As Long
End Type

Private Const NIM_ADD As Long = &H0&
Private Const NIM_MODIFY As Long = &H1&
Private Const NIF_INFO As Long = &H10&

Private Function Min(ByVal a As Long, ByVal b As Long) As Long
  If a < b Then Min = a Else Min = b
End Function

Public Sub Toast(Optional ByVal title As String, Optional ByVal info As String, Optional ByVal flag As Long)
  Dim nfIconData As NOTIFYICONDATAW
  
  info = info & " "
  title = title & " "
  With nfIconData
    .cbSize = Len(nfIconData)
    
    .uFlags = NIF_INFO
    .dwInfoFlags = flag
    
    If Len(title) > 0 Then
      CopyMemory ByVal VarPtr(.szInfoTitle(LBound(.szInfoTitle))), ByVal StrPtr(title), Min(Len(title) * 2, UBound(.szInfoTitle) - LBound(.szInfoTitle) + 1 - 2)
    End If
    
    If Len(info) > 0 Then
      CopyMemory ByVal VarPtr(.szInfo(LBound(.szInfo))), ByVal StrPtr(info), Min(Len(info) * 2, UBound(.szInfo) - LBound(.szInfo) + 1 - 2)
    End If
  End With
  
  Shell_NotifyIconW NIM_ADD, nfIconData
  Shell_NotifyIconW NIM_MODIFY, nfIconData
End Sub

Sub ShowSystemTrayMsg()
    
    Toast "title", "msg"

End Sub

Sub Создать_групы_CSV()

    Dim arrData, i As Long, n As Long
    Dim Coll As New Collection
    Dim NewWb As Workbook
    Dim thisWBpath As String
    thisWBpath = ActiveWorkbook.Path

    arrData = Range("A1").CurrentRegion
    
    On Error Resume Next
    For i = 2 To UBound(arrData, 1)
        If Len(arrData(i, 1)) > 0 Then Coll.Add arrData(i, 1), arrData(i, 1)
    Next i
    On Error GoTo 0
    
    If MsgBox("Создать " & Coll.count & " файлов CSV?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    For Each Item In Coll
        n = 1
        Set NewWb = Workbooks.Add(1)
        With NewWb.Worksheets(1)
            .[A1] = "PurchID": .[B1] = "itemid": .[C1] = "PurchQty": .[D1] = "PurchPrice": .[E1] = "Site/Warehouse/Location"
            For i = 2 To UBound(arrData, 1)
                If arrData(i, 1) = Item Then
                    n = n + 1
                    .Cells(n, 2) = arrData(i, 2)
                    .Cells(n, 3) = arrData(i, 3)
                    .Cells(n, 4) = arrData(i, 4)
                    .Cells(n, 5) = "WM00315208"
                    .Cells(n, 1) = arrData(i, 5)
                End If
            Next i
        End With
        ChDir thisWBpath
        NewWb.SaveAs fileName:=thisWBpath & "\" & Item & ".csv", FileFormat:=24, Local:=True '6 '23 '62 'xlCSVUTF8
        NewWb.Close (False)
    Next Item
    Application.ScreenUpdating = True
    MsgBox "Файлы сохранены!", vbInformation, "Конец"
End Sub

Sub Combinator2()
    Dim Data() As Variant, goal As Double, sel_count As Integer, prec As Double, t As Single, AddSum As Double
    Const LIMIT = 1000000
    Randomize
    
    prec = Range("D5").Value
    sel_count = Range("D2").Value
    goal = Range("D4").Value
    
    Set OutRange = Range("D8")
    Set InputRange = Range("A1", Range("A1").End(xlDown))
    input_count = InputRange.Cells.Count
    Data = InputRange.Value
    t = Timer

    Do
        AddSum = 0
        For j = 1 To sel_count
            RandomIndex = Int(Rnd * (input_count - j + 1) + j)
            RandomValue = Data(RandomIndex, 1)
            AddSum = AddSum + RandomValue
            Data(RandomIndex, 1) = Data(j, 1)
            Data(j, 1) = RandomValue
        Next j
        If Abs(AddSum - goal) <= prec Then
            Range("D3").Value = AddSum
            Debug.Print Timer - t, iterations
            MsgBox "Подбор завершен. Необходимая точность достигнута."
            Range(OutRange, OutRange.End(xlDown)).ClearContents
            OutRange.Resize(sel_count, 1).Value = Data
            Exit Sub
        End If
        iterations = iterations + 1
    Loop While iterations <= LIMIT
    Debug.Print Timer - t
    MsgBox "Достигнут лимит попыток. Решение не найдено."
End Sub

Sub определить_типы()

Dim mass1(), mass2(), mass3(), mass4(), mass5(), mass6(), mass7(), mass8() As Variant

' вмещает
mass1 = Array("AR", "F70", "N11F", "LR", "LLB")
' заканчивается
mass2 = Array("L60", "H00", "F60L", "N72", "K3")
' начинается
mass3 = Array("11", "13", "31", "33")
' равно
mass4 = Array("40400", "1884LST", "1785K")
' начинается на элемент из mass5 и заканчивается на элемент из mass6
mass5 = Array("31", "37", "51", "71", "76")
mass6 = Array("S00", "M00", "L00")
' если элемент из содержит mass7, но не содержит элемент из mass8
mass7 = Array("NF")
mass8 = Array("CO")

lr = Cells(1, 1).End(xlDown).Row
    For i = 2 To lr
        Cells(i, 2).Value = получить_тип_модели(Cells(i, 1).Value)
    Next i
End Sub

Private Sub получить_тип_модели(model_name As String)

' тут опредиление типа

End Sub

Sub формат_печати_последней_страницы()

Dim numAllPages As Long
Dim lastRowDiap As Long
Dim lastRowSheet As Long
Dim numlastRowDiapPage As Long
Dim numlastRowSheetPage As Long

' задать параметры печати
With Worksheets(1).PageSetup
 .LeftMargin = Application.InchesToPoints(0)
 .RightMargin = Application.InchesToPoints(0)
 .TopMargin = Application.InchesToPoints(0)
 .BottomMargin = Application.InchesToPoints(0)
 .HeaderMargin = Application.InchesToPoints(1.3)
 .FooterMargin = Application.InchesToPoints(1.3)
End With

With Worksheets(1).PageSetup
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = 1000
End With

' узнать количество страниц печати
ActiveWindow.View = xlPageBreakPreview
numAllPages = Worksheets(1).HPageBreaks.Count + 1


' записать номер страницы где находится последняя строка всего листа
numlastRowSheetPage = numAllPages

' узнать номер последней строки из определенного диапазона
lastRowDiap = Cells(10, 1).End(xlDown).Row

' узнать номер последней строки из всего листа
last = Cells(10, 6).End(xlDown).Row
lastRowSheet = Cells(last, 6).End(xlDown).Row

' узнать номер страницы где находится последняя строка нашего диапазона
Cells(lastRowDiap, 1).Activate
For i = 1 To ActiveSheet.HPageBreaks.Count
    If ActiveCell.Row < ActiveSheet.HPageBreaks(i).Location.Row - 1 Then Exit For
Next
numlastRowDiapPage = i

' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' условие если последние строки на разных страницах
Do Until numlastRowDiapPage = numlastRowSheetPage
lr = Cells(11, 1).End(xlDown).Row
rowHei = Range(Cells(11, 1), Cells(lr, 1)).RowHeight
rowHei = rowHei + 1

' узнать количество страниц печати
ActiveWindow.View = xlPageBreakPreview
numAllPages = Worksheets(1).HPageBreaks.Count + 1
ActiveWindow.View = xlNormalView

' записать номер страницы где находится последняя строка всего листа
numlastRowSheetPage = numAllPages

' узнать номер последней строки из определенного диапазона
lastRowDiap = Cells(10, 1).End(xlDown).Row

' узнать номер последней строки из всего листа
last = Cells(10, 6).End(xlDown).Row
lastRowSheet = Cells(last, 6).End(xlDown).Row

' узнать номер страницы где находится последняя строка нашего диапазона
Cells(lastRowDiap, 1).Activate
For i = 1 To ActiveSheet.HPageBreaks.Count
    If ActiveCell.Row < ActiveSheet.HPageBreaks(i).Location.Row - 1 Then Exit For
Next
numlastRowDiapPage = i
Loop
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ActiveWindow.View = xlNormalView
MsgBox ("Количество всех страниц: " & numAllPages & "; " & "Последняя строка в диапазоне: " & lastRowDiap & "; " & "Последняя строка на листе: " & lastRowSheet & "; " & "Номер страницы строки диапазона: " & numlastRowDiapPage & "; " & "Номер страницы последней строки: " & numlastRowSheetPage & "; ")

End Sub