=ТЕКСТ(СЕГОДНЯ()+3;"ДД.ММ.ГГГГ")

dim aShapes
ReDim aShapes(0 to 3)
'здесь можно и циклом, но принцип понятен
set aShapes(0) = ws.Shapes(5)
set aShapes(1) = ws.Shapes(6)
set aShapes(2) = ws.Shapes(7)
set aShapes(3) = ws.Shapes(8)
Call FillPP(oPPTPres, 2, aShapes)

Function FillPP(pPres As Presentation, SlideNo As Long, cCharts)

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
 ' default local Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Задачи").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
 
  On Error GoTo ErrorHandler
  Dim Msg As Outlook.MailItem
  If TypeName(item) = "MailItem" Then
    Set Msg = item
    ' ******************
    ' do something here
    MsgBox ("пришло письмо")
    ' ******************
  End If
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

ImaKnig1.Activate
Sheets("Спецификация").Range("B5").Select

Application.EnableEvents = False 'отключаете обработку событий (чтоб не срабатывала вставка только значений)(Application.Undo)
  Workbooks.Open (ImaKnig2)
  Workbooks(ImaKnig3).Worksheets("Спецификация").Range("B5:G705").Copy
'  ImaKnig1.Activate
'  Sheets("Спецификация").Range("B5").Select
  ImaKnig1.Sheets("Спецификация").Range("B5").PasteSpecial Paste:=xlPasteValues
'  Range("B5").Select
  
  Application.CutCopyMode = False 'очистка буфера обмена
  Workbooks(ImaKnig3).Close (False)
  Application.EnableEvents = True 'включаете обработку событий

Function getAddress(sv As Integer, r As Range, sType As String)

For Each Item In r
If Item.Value = sv Then
If sType = "str" Then 'нужен только адрес
getAddress = Item.Address
Else
Set getAddress = Item
End If
Exit Function
End if
Next Item

End Function

= ДВССЫЛ(getAddress(1;A1:D15))
= ЯЧЕЙКА("адрес";getAddress(1;A1:D15;"obj"))

Debug.Print "4.", Me.tb.Value = vbNewLine

asc(ch) = 182

Application.Workbooks(ImaKnig3).Worksheets("Спецификация").Range("A5:J23").Copy
        ImaKnig1.Sheets("Спецификация").Range("A5").PasteSpecial xlPasteValues

IOK = Dir(odir)
If IOK <> "" then
'блок обработки этого самого IOK
end if

Workbooks.OpenText Filename:= _
        iPapka1, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
         
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
             
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
 
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
         
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
 
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
 
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
 
Windows(INK1).Activate
Windows(INK1).Close

If Dir(iPapka1) <> "" then
Workbooks.OpenText Filename:= _
        iPapka1, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
         
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
             
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
 
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
         
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
 
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
 
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
 
Windows(INK1).Activate
Windows(INK1).Close
end if

Sub Кнопка1_Щелчок()
UserForm1.Show
End Sub

Sub Кнопка1_Щелчок()
UserForm1.Show
End Sub
'вызов формы поиска
Sub CallFind()
ufFind.Show
End Sub