Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ДЛСТР(СЖПРОБЕЛЫ(H6))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

Sub NextIfNoAction()

Dim Wbn As String
Wbn = Application.Caller.Worksheet.Parent.Name
If Wbn = "Update" Then
Call UserForm2.CommandButton1_Click
Else
End If

End Sub

Sub CopyRangeToPresentation()

'Шаг 1: Объявляем переменные
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideTitle As String

'Шаг 2: Откройте PowerPoint и создайте новую презентацию
Set PP = New PowerPoint.Application
Set PPPres = PP.Presentations.Add
PP.Visible = True

'Шаг 3: Добавьте новый слайд как слайд 1 и установите на него фокус
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide.Select

'Шаг 4: Скопируйте диапазон, как изображение
Sheets("Statistics").Range("D515:AR568").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Шаг 5: Вставьте картинку и отрегулируйте ее положение
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

'Шаг 6: Добавьте новый слайд как слайд 2 и установите на него фокус
Set PPSlide = PPPres.Slides.Add(2, ppLayoutTitleOnly)
PPSlide.Select

'Шаг 7: Скопируйте диапазон, как изображение
Sheets("Statistics").Range("D576:AR629").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Шаг 8: Вставьте картинку и отрегулируйте ее положение
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

'Шаг 9: Добавьте новый слайд как слайд 3 и установите на него фокус
Set PPSlide = PPPres.Slides.Add(3, ppLayoutTitleOnly)
PPSlide.Select

'Шаг 10: Скопируйте диапазон, как изображение
Sheets("Statistics").Range("D637:AR690").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Шаг 11: Вставьте картинку и отрегулируйте ее положение
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

'Шаг 12: Добавьте новый слайд как слайд 4 и установите на него фокус
Set PPSlide = PPPres.Slides.Add(4, ppLayoutTitleOnly)
PPSlide.Select

'Шаг 13: Скопируйте диапазон, как изображение
Sheets("Statistics").Range("D698:AR751").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

'Шаг 14: Вставьте картинку и отрегулируйте ее положение
PPSlide.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

'Шаг 15: Очистка памяти

Presentation.SaveAs ThisWorkbook.Path & "\Programm Data\LSS\" & ThisWorkbook.Name & ".pptx"

End Sub

Sub trytryrty()  
  
For i = 1 To ThisWorkbook.Sheets("Constructor").Cells(Rows.Count, 3).End(xlUp).Row  
    For j = 1 To ThisWorkbook.Sheets.Count  
        If ThisWorkbook.Sheets("Constructor").Cells(i, 3).Value = Sheets(j).Name Then  
            ThisWorkbook.Sheets("Constructor").Range(Cells(i, 3).Offset(1, 20), Cells(i, 3).Offset(1, 36)).Copy  
            Set aaa = ThisWorkbook.Sheets("Constructor").Cells(i, 3).Offset(0, -1)  
            Set bbb = ThisWorkbook.Sheets(j).Range("AH1:AI1000").Find(aaa, , xlValues, xlWhole).Offset(0, -30)  
            Set ccc = ThisWorkbook.Sheets(j).Columns(bbb.Column).Find("18", , xlValues, xlWhole).Offset(0, 2)  
        End If  
    Next  
Next  
  
End Sub  

Set ccc = ThisWorkbook.Sheets(j).Columns(bbb.Column).Find("18", , xlValues, xlWhole).Offset(0, 2)

Sub tost7()
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    For j = 1 To ThisWorkbook.Sheets.Count
        If Cells(i, 2).Value = Sheets(j).Name And Sheets(j).Name <> ActiveSheet.Name Then
                Sheets(j).Cells(1, 1).Value = "!"
        End If
    Next
Next
End Sub

Sheets(j).Cells(1, 1).Value = "!"

[k5].Formula = [i5].Value
[K7].Formula = [I7].Value
[k9].Formula = [I9].Value

Sub Try()

    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(6, 0)).Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    ActiveSheet.Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(6, 0)).ClearOutline
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(6, 0)).Select
    Selection.Replace What:="[" & ActiveCell.Offset(-1, -1), Replacement:="[" & ActiveCell.Offset(-1, 0), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
 
End Sub

Sub Shift_paste()
Selection = [E2]
ActiveCell.Offset(0, 1) = [G2]
ActiveCell.Offset(0, 2) = Application.UserName
End Sub

Sub Send_Report()
    Dim oOutlApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sTblBody As String, sAttachment As String, sCC As String
    Dim rDataR As Range
    Dim IsOultOpen As Boolean
 
    Application.ScreenUpdating = False
    'Пробуем подключиться к Outlook
    On Error Resume Next
    Set oOutlApp = GetObject(, "Outlook.Application")
    If Err = 0 Then
        IsOultOpen = True
    Else
        Err.Clear
        Set oOutlApp = CreateObject("Outlook.Application")
    End If
    oOutlApp.Session.Logon
    Set objMail = oOutlApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set oOutlApp = Nothing: Set objMail = Nothing: Exit Sub
    
    With ActiveWorkbook.Sheets("Send_Report_Form")
        sTo = .Range("C2").Value
        sCC = .Range("C3").Value
        sSubject = .Range("C4").Value
        sBody = .Range("C5").Value
        'Переносы строк и шрифт
        sBody = Replace(sBody, Chr(10), "<br />")
        sBody = Replace(sBody, vbNewLine, "<br />")
        sBody = "<span style=""font-size: 14.5px; font-family: Arial"">" & sBody & "</span>"
        'Таблица
        'важно добавлять таблицу после оформления переносов строк и шрифта
        'в противном случае форматирование таблицы может "поплыть"
        Set rDataR = Sheets("Status").Range("D4:K10") 'Selection - если надо отправить только выделенные диапазона
        sTblBody = ConvertRngToHTM(rDataR)
        'подменяем метку {TABLE} в тексте письма реальной таблицей(сформированной выше)
        sBody = Replace(sBody, "{TABLE}", sTblBody)
    End With
    
    
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = sCC 'адрес для копии
'       .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .BodyFormat = 2  'olFormatHTML - формат HTML
'        .Body = RangeToTextTable(Selection) 'вставляем таблицу без форматирования
        .HTMLBody = sBody
        If sAttachment <> "" Then
            .Attachments.Add sAttachment
        End If
        .display 'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send 'если необходимо отправить сообщение без просмотра
    End With
    
    If IsOultOpen = False Then oOutlApp.Quit
    Set oOutlApp = Nothing: Set objMail = Nothing
    DoEvents
End Sub
 
Function ConvertRngToHTM(rng As Range)
    Dim fso As Object, ts As Object
    Dim sF As String, resHTM As String
    Dim wbTmp As Workbook
 
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'переносим указанный диапазон в новую книгу
    rng.Copy
    Set wbTmp = Workbooks.Add(1)
    With wbTmp.Sheets(1)
        'вставляем только ширину столбцов, значения и форматы
        .Cells(1).PasteSpecial xlPasteColumnWidths
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        'удаляем все объекты(фигуры, рисунки и пр.)
        '------------------------------------------
        'если рисунки и объекты нужны - удалить этот блок
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
        '------------------------------------------
    End With
    'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)
    With wbTmp.PublishObjects.Add( _
         SourceType:=xlSourceRange, Filename:=sF, _
         Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'открываем созданный файл как текстовый и считываем содержимое
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
    'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)
    ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    'закрываем временную книгу и удаляем
    wbTmp.Close False
    Kill sF
    'очищаем объектные переменные
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
End Function
 
'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: функция объединяет значения указанного диапазона ячеек в строку
'          разрывы между столбцами заменяются табуляцией
'          разрывы между строками заменяются переносами на строки
'---------------------------------------------------------------------------------------
Function RangeToTextTable(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String, rh()
    Dim lSpaces As Long, s As String
     
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    ReDim rh(1 To UBound(arr, 2))
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If Len(arr(lr, lc)) > rh(lc) Then
                rh(lc) = Len(arr(lr, lc))
            End If
        Next
    Next
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            s = arr(lr, lc)
            lSpaces = rh(lc) - Len(s)
            If lSpaces > 0 Then
                s = s & Space(lSpaces)
            End If
            If lc = 1 Then
                res = res & s
            Else
                res = res & vbTab & s
            End If
        Next
        res = res & vbNewLine
    Next
    RangeToTextTable = res
End Function

Sub Choose_Report()  ' пример использования
    Filename$ = GetFilePath()
    If Filename$ = "" Then Exit Sub
    MsgBox "Выбран файл: " & Filename$
End Sub
 
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:\", _
                     Optional ByVal FilterDescription As String = "Файлы счетов", _
                     Optional ByVal FilterExtention As String = "*.*") As String
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title:
        .InitialFileName = GetSetting(Application.Name, "GetFilePath", "folder", InitialPath)
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1)
        folder$ = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
        SaveSetting Application.Name, "GetFilePath", "folder", folder$
    End With
End Function

.Attachments.Add GetFilePath()

Sub Send_Mail()
    Dim oOutlApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sTblBody As String, sAttachment As String
    Dim rDataR As Range
    Dim IsOultOpen As Boolean
 
    Application.ScreenUpdating = False
    'Пробуем подключиться к Outlook
    On Error Resume Next
    Set oOutlApp = GetObject(, "Outlook.Application")
    If Err = 0 Then
        IsOultOpen = True
    Else
        Err.Clear
        Set oOutlApp = CreateObject("Outlook.Application")
    End If
    oOutlApp.Session.Logon
    Set objMail = oOutlApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set oOutlApp = Nothing: Set objMail = Nothing: Exit Sub
    
    With ActiveWorkbook.Sheets("Status")
        sTo = .Range("P2").Value
        sSubject = .Range("P3").Value
        sBody = .Range("P4").Value
        'Переносы строк и шрифт
        sBody = Replace(sBody, Chr(10), "<br />")
        sBody = Replace(sBody, vbNewLine, "<br />")
        sBody = "<span style=""font-size: 14.5px; font-family: Arial"">" & sBody & "</span>"
        'Таблица
        'важно добавлять таблицу после оформления переносов строк и шрифта
        'в противном случае форматирование таблицы может "поплыть"
        Set rDataR = .Range("A1:N14") 'Selection - если надо отправить только выделенные диапазона
        sTblBody = ConvertRngToHTM(rDataR)
        'подменяем метку {TABLE} в тексте письма реальной таблицей(сформированной выше)
        sBody = Replace(sBody, "{TABLE}", sTblBody)
    End With
    
    
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = [P5] 'адрес для копии
'       .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .BodyFormat = 2  'olFormatHTML - формат HTML
'        .Body = RangeToTextTable(Selection) 'вставляем таблицу без форматирования
        .HTMLBody = sBody
        If sAttachment <> "" Then
            .Attachments.Add sAttachment
        End If
        .display 'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send 'если необходимо отправить сообщение без просмотра
    End With
    
    If IsOultOpen = False Then oOutlApp.Quit
    Set oOutlApp = Nothing: Set objMail = Nothing
    DoEvents
End Sub

Function ConvertRngToHTM(rng As Range)
    Dim fso As Object, ts As Object
    Dim sF As String, resHTM As String
    Dim wbTmp As Workbook
 
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'переносим указанный диапазон в новую книгу
    rng.Copy
    Set wbTmp = Workbooks.Add(1)
    With wbTmp.Sheets(1)
        'вставляем только ширину столбцов, значения и форматы
        .Cells(1).PasteSpecial xlPasteColumnWidths
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        'удаляем все объекты(фигуры, рисунки и пр.)
        '------------------------------------------
        'если рисунки и объекты нужны - удалить этот блок
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
        '------------------------------------------
    End With
    'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)
    With wbTmp.PublishObjects.Add( _
         SourceType:=xlSourceRange, Filename:=sF, _
         Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'открываем созданный файл как текстовый и считываем содержимое
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
    'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)
    ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    'закрываем временную книгу и удаляем
    wbTmp.Close False
    Kill sF
    'очищаем объектные переменные
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
End Function

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: функция объединяет значения указанного диапазона ячеек в строку
'          разрывы между столбцами заменяются табуляцией
'          разрывы между строками заменяются переносами на строки
'---------------------------------------------------------------------------------------
Function RangeToTextTable(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String, rh()
    Dim lSpaces As Long, s As String
     
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    ReDim rh(1 To UBound(arr, 2))
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If Len(arr(lr, lc)) > rh(lc) Then
                rh(lc) = Len(arr(lr, lc))
            End If
        Next
    Next
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            s = arr(lr, lc)
            lSpaces = rh(lc) - Len(s)
            If lSpaces > 0 Then
                s = s & Space(lSpaces)
            End If
            If lc = 1 Then
                res = res & s
            Else
                res = res & vbTab & s
            End If
        Next
        res = res & vbNewLine
    Next
    RangeToTextTable = res
End Function

Sub PDFActiveSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim strWd As String
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh-mm")
wbA.Save
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = "W" & Format(DatePart("WW", Now, vbMonday), "00")
strWd = Weekday(Date, vbMonday)
strName = strName & "-" & strWd
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF-????? (*.pdf), *.pdf", _
        Title:="????? ????? ? ????? ?????")
'export to PDF if a folder was selected
If myFile <> "False" Then
    wbA.PrintOut ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=strFile
    'confirmation message with file info
    MsgBox "PDF-????? ??????: " _
      & vbCrLf _
      & myFile
End If
exitHandler:
    Exit Sub
errHandler:
    MsgBox "?? ??????? ??????? PDF-?????"
    Resume exitHandler
End Sub

Sub PDFActiveSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")
wbA.Save
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = DatePart("WW", Now, vbMonday)
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF-????? (*.pdf), *.pdf", _
        Title:="????? ????? ? ????? ?????")
'export to PDF if a folder was selected
If myFile <> "False" Then
    wbA.PrintOut ActivePrinter:="Microsoft Print to PDF", PrintToFile:=True, PrToFileName:=strFile
    'confirmation message with file info
    MsgBox "PDF-????? ??????: " _
      & vbCrLf _
      & myFile
End If
exitHandler:
    Exit Sub
errHandler:
    MsgBox "?? ??????? ??????? PDF-?????"
    Resume exitHandler
End Sub

Sub PDFActiveSheet()
 
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
 
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "ddmmyyyy\_hhmm")
 
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
 
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
 
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
 
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF-файлы (*.pdf), *.pdf", _
        Title:="Выбор папки и имени файла")
 
'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
   MsgBox "PDF-файл создан: " _
      & vbCrLf _
      & myFile
End If