add_func.bas

Attribute VB_Name = "add_func"

' status: work
' âèçóàëüíîå îôîðìëåíèå ïðèìå÷àíèÿ(êîììåíòàðèÿ) ÿ÷åéêè

Sub install_comment_style(cell As Range)
    
    With cell.comment.Shape
        .TextFrame.AutoSize = True
        '.AutoShapeType = msoShapeRoundedRectangle 'çàêðóãëåíèå óãëîâ âñïëûâàþùåé ïîäñêàõêè
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.Transparency = 0.1
        .Line.Visible = msoTrue ' Ïîêàçûâàåì ãðàíèöó êîììåíòàðèÿ
        .Line.ForeColor.RGB = RGB(0, 0, 0) ' Çàäàåì öâåò ãðàíèöû (÷åðíûé)
        .Line.Weight = 0.1 ' Çàäàåì òîëùèíó ãðàíèöû
        .TextFrame.Characters.Font.Size = 8
        .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
        .TextFrame.MarginLeft = 1000   ' Îòñòóï ñëåâà
        .TextFrame.MarginRight = 1000  ' Îòñòóï ñïðàâà
        .TextFrame.MarginTop = 5000  ' Îòñòóï ñâåðõó
        .TextFrame.MarginBottom = 5000 ' Îòñòóï ñíèçó
        
    End With
    
End Sub

' status: work
' óçíàòü áóêâû ñòîëáöà, çíàÿ íîìåð

Function column_name(ByVal column_number As Long) As String
    If column_number <= 0 Then
        column_name = "error"
    Else
        column_name = Left(Cells(1, column_number).Address(False, False), Len(Cells(1, column_number).Address(False, False)) - 1)
    End If
    
End Function

' status: work
' Ïîñëå êîïèðîâàíèÿ äàííûõ èç ÀÏÖ!ÑËÈÏ-×ÅÊ|ÒÄ
'   óñòàíîâèòü ôèëüòð ïî ñòîëáöó "Ñïåöèàëèñò" â ÇÀÊÀÇÍÈÊ!ÑËÈÏ-×ÅÊ|ÒÄ

Sub enable_filter_on_manager(ByRef ws As Worksheet)
    
    If ws.FilterMode Then
        ws.ShowAllData ' ñáðîñèòü âñå àêòèâíûå ôèëüòðû
    End If
    
    If ws.AutoFilterMode = False Then
        ws.Range("1:1").AutoFilter Field:=33, Criteria1:=Application.UserName
    End If

End Sub

' status: work
' (ÑËÈÏ-×ÅÊ|ÒÄ)
' ñîðòèðóåì äàííûå ïî ñòîëáöàì: Íàçâàíèå àêöèè (2), Ñïåöèàëèñò (33), Íàçâàíèå ÊÀ (35)

Sub sort_sctd(ByRef ws As Worksheet)

    Dim sort_range As Range
    Set sort_range = ws.Range("A1").CurrentRegion
    
    With ws.Sort
        .Header = xlYes
        .SortFields.Clear
        .SortFields.Add Key:=ws.Columns(2), Order:=xlAscending ' Ïðîâåðêà çàëîæåííûõ îáúåìîâ %
        .SortFields.Add Key:=ws.Columns(6), Order:=xlAscending ' Àêöèÿ ñ
        .SortFields.Add Key:=ws.Columns(33) ' Ìåíåäæåð (Ñïåöèàëèñò)
        .SortFields.Add Key:=ws.Columns(35) ' Íàèìåíîâàíèå ÊÀ
        .SetRange sort_range ' äèàïàçîí äåéñòâèÿ ôèëüòðîâ
        .Apply ' Àêòèâàðîâàòü ôèëüòðû
    End With

End Sub

' status: work
' Ôóíêöèÿ ïîèñêà çíà÷åíèÿ ïîñëåäíåé çàïîëíåíîé ñòðîêè íà ëèñòå

Function find_last_row(ByVal ws As Worksheet) As Long

    Dim last_row As Long
    last_row = ws.Cells.Find(What:="*" _
                        , LookAt:=xlPart _
                        , LookIn:=xlFormulas _
                        , SearchOrder:=xlByRows _
                        , searchdirection:=xlPrevious).row
    find_last_row = last_row
    
End Function

' status: work
' Ôóíêöèÿ ïîèñêà çíà÷åíèÿ ïîñëåäíåãî çàïîëíåíîãî ñòîëáöà íà ëèñòå

Function find_last_column(ByVal ws As Worksheet) As Long

    Dim last_column As Long
    last_column = ws.Cells.Find(What:="*" _
                        , LookAt:=xlPart _
                        , LookIn:=xlFormulas _
                        , SearchOrder:=xlByColumns _
                        , searchdirection:=xlPrevious).Column
    find_last_column = last_column

End Function

' status: work
' OFF

Sub turn_off_functionalities()

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

End Sub

' status: work
' ON
Sub turn_on_functionalities()

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

' status: debug
' êàñòîìíîå ñîîáùåíèå ñ âõîäÿùèìè àðãóìåíòàìè
' çàâèñèìîñòè: close_custom_message()

'Sub show_custom_msgbox(ByVal text_caption As String)
'    Dim msgbox_form As Object
'    Set msgbox_form = CreateObject("Forms.Form")
'
'    With msgbox_form
'        .Width = 300
'        .Height = 150
'        .Caption = "Update"
'        .BorderStyle = 1 ' Ôèêñèðîâàííûé ðàçìåð
'
'        ' Òåêñò ñîîáùåíèÿ
'        Dim label As Object
'        Set label = .Controls.Add("Forms.Label.1", "MsgLabel")
'        With label
'            .Caption = text_caption
'            .Left = 10
'            .Top = 10
'            .Width = 280
'            .Height = 80
'            .TextAlign = 2 ' Âûðàâíèâàíèå òåêñòà ïî öåíòðó
'        End With
'
'        ' Êíîïêà "OK"
'        Dim okButton As Object
'        Set okButton = .Controls.Add("Forms.CommandButton.1", "OkButton")
'        With okButton
'            .Caption = "OK"
'            .Width = 100
'            .Height = 30
'            ' Ðàññ÷èòûâàåì ïîëîæåíèå êíîïêè ïî ãîðèçîíòàëè
'            .Left = (.Parent.Width - .Width) / 2
'            ' Ðàññ÷èòûâàåì ïîëîæåíèå êíîïêè ïî âåðòèêàëè
'            .Top = (.Parent.Height - .Height) / 2
'            .Default = True ' Ñäåëàòü êíîïêó ïî óìîë÷àíèþ (äëÿ íàæàòèÿ êëàâèøè Enter)
'        End With
'
'        ' Îáðàáîò÷èê ñîáûòèÿ äëÿ êíîïêè "OK"
'        msgbox_form.Controls("OkButton").OnAction = "close_custom_message_box"
'
'        .Show
'    End With
'
'End Sub

' status: debug
' èñïîëüçóåòñÿ â: show_custom_msgbox()

'Sub close_custom_message_box()
''    Unload Me
'End Sub