'   если путь надо указать статичный - вместо диалога прописываем одну строку
'   sPicsPath = "C:\images\"

sPicsPath = ThisWorkbook.Path

=(ВЗЯТЬ(E2#;;1)=ДЕНЬНЕД(СЕГОДНЯ();11))*
   (ВЗЯТЬ(ВЗЯТЬ(E2#;;7);;-1)<=ВРЕМЗНАЧ(ТЕКСТ(ТДАТА();"ЧЧ:ММ:СС")))*
   (ВЗЯТЬ(E2#;;-1)>=ВРЕМЗНАЧ(ТЕКСТ(ТДАТА();"ЧЧ:ММ:СС")))

=(ВЗЯТЬ(E2#;;1)=ДЕНЬНЕД(СЕГОДНЯ();11))*
   (ВЗЯТЬ(ВЗЯТЬ(E2#;;7);;-1)<=ВРЕМЗНАЧ(ТЕКСТ(ТДАТА();"ЧЧ:ММ:СС")))*
   (ВЗЯТЬ(E2#;;-1)>=ВРЕМЗНАЧ(ТЕКСТ(ТДАТА();"ЧЧ:ММ:СС")))<>0

oShp.Name = sSpName

oShp.OnAction = "ClickResizeImage"

Sub PlaceImage(Cel As Range, SHP As Shape)    Dim W As Double, H As Double, L As Double, T As Double
    Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
    With SHP
        .LockAspectRatio = msoTrue
        .Width = W
        If .Height > H Then .Height = H
        .Left = L + (W - SHP.Width) / 2
        .Top = T + (H - SHP.Height) / 2
    End With
End Sub
Sub ClickResizeImage()
    Dim SHP As Shape, Cel As Range, W As Double, H As Double, L As Double, T As Double
    Set SHP = ActiveSheet.Shapes(Application.Caller)
    Set Cel = SHP.TopLeftCell
    Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
    If SHP.Width < W Or SHP.Height < H Then SHP.Width = W * 5 Else Call PlaceImage(Cel, SHP)
End Sub

">="&ДАТА(2025;1;1)

Sub DelFromWb()
    Dim ws As Worksheet
    for each ws in activeworkbook.Worksheets
    'здесь код для удаления всех объектов с листа, который знаю :)
    'или такой:
    On Error resume next
    ws.drawingobjects.delete
    On Error goto 0
    next
End Sub

=--ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;"мая";"май");СИМВОЛ(160);" ");",";"");".";"")

=ЗНАЧЕН(ПОДСТАВИТЬ(A1;".,";""))

=--ПОДСТАВИТЬ(A1;".,";"")

=СУММЕСЛИ(СМЕЩ($B$2;ПОИСКПОЗ($E11;$A$3:$A$20;0);0;ПОИСКПОЗ("Прим.:";СМЕЩ($A$2;ПОИСКПОЗ($E11;$A$3:$A$20;0);0;20);0)); F$10;СМЕЩ($C$2;ПОИСКПОЗ($E11;$A$3:$A$20;0);0;ПОИСКПОЗ("Прим.:";СМЕЩ($A$2;ПОИСКПОЗ($E11;$A$3:$A$20;0);0;20);0)))

=B1&СИМВОЛ(10)&C1&СИМВОЛ(10)&D1

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rc As Range
    
    On Error Resume Next
    For Each rc In Target
        If InStr(1, rc.Formula, "=ИзвлечьДатуДокумента1(", 1) > 0 Then
            rc.NumberFormat = "dd.MM.yyyy"
        End If
    Next
End Sub

Public Function ИзвлечьДатуДокумента1(Text As String) As Date
    ИзвлечьДатуДокумента1 = CDate(MyReg(Text, "\d{2}\.\d+\.\d+"))
End Function