Помогите с макросами на Save As и Open

[Leanna]

Друзья! Помогите пожалуйста с двумя макросами на Save As и Open:

1) Макрос берет данные из ячейки А1 (например «Счет-Фактура 699») и
сохраняет файл «Счет-Фактура 699.xls» в директории «C:\Поставщики»

2) Макрос открывает файл с максимальным номером из «C:\Поставщики».
Например в директории «C:\Поставщики» есть два файла «Счет-
Фактура 699.xls» и «Счет-Фактура 700.xls» нужно что бы макрос
открыл «Счет-Фактура 700.xls».

Спасибо.

[pashulka]

1.

Private Sub SaveAsFile()
    iPath$ = "C:\Поставщики\"
    If Dir(iPath$, vbDirectory) = "" Then
       MsgBox "Указанная папка изволит отсутствовать", , ""
       Exit Sub
    End If
    
    With ActiveWorkbook
         .SaveAs Filename:=iPath$ & _
         .Worksheets(1).Range("A1").Value, FileFormat:=xlNormal
    End With
End Sub

Естественно, что рабочая книга, которую необходимо сохранить в указанную папку не обязательно должна быть активной, а ячейка, данные которой служат именем файла, может принадлежать любому листу. Проще говоря, это только пример, причём только "основная" его часть, т.к. было бы весьма неплохо добавить проверку на корректность данных ячейки "A1", ибо имя файла не должно содержать более 255 символов, кроме того, существуют символы, которые не могут быть использованы в имени. Впрочем, если данные будут вводиться эту ячейку только вручную, то используя проверку данных (Данные-Проверка-Параметры- список: Другой-поле: Формула) можно запретить ввод данных, которые не могут быть использованы в качестве имени файла.

P.S. Не стоит также забывать, что в указанной папке уже может наличествовать файл с сохраняемым именем.

[pashulka]

2.

Private Sub OpenFile()
    iPath$ = "C:\Поставщики\"
    If Dir(iPath$, vbDirectory) = "" Then
       MsgBox "Указанная папка изволит отсутствовать", , ""
       Exit Sub
    End If
    
    With Application.FileSearch 'XL97, 2000, 2002, 2003
         'Вместо об'екта FileSearch
         'можно использовать функцию Dir (примеры есть на этом форуме)
         .NewSearch
         .LookIn = iPath$
         .FileName = "*.xls"
         If .Execute > 0 Then
            iCountFile& = .FoundFiles.Count
            ReDim iNumeric(1 To iCountFile&, 1 To 2)
            For iCount& = 1 To iCountFile&
                iFileName$ = .FoundFiles(iCount&)
                If iFileName$ Like "*#.xls" Then
                   iNumeric(iCount&, 1) = NumFile(iFileName$)
                   iNumeric(iCount&, 2) = iFileName$
                End If
            Next
            With Application
                 If .Count(iNumeric) = 0 Then
                    MsgBox "Не обнаружено ни одного нужного файла", , ""
                    'Предполагается, что :
                    '- счётчик находится в конце имени
                    '- он может содержать различное количество цифр
                    '- эти цифры располагаются последовательно
                    Exit Sub
                 End If
                 iOpenFile$ = _
                 .VLookup(.Max(iNumeric), iNumeric, 2, 0)
                 .Workbooks.Open FileName:=iOpenFile$, UpdateLinks:=0
            End With
         End If
    End With
End Sub

Private Function NumFile&(FileName$)
    For iCount% = Len(FileName$) - 4 To 1 Step -1
        iSymbol$ = Mid(FileName$, iCount%, 1)
        If Not IsNumeric(iSymbol$) Then
           NumFile& = CLng(iTemp$) 'iTemp$
           Exit Function
        End If
        iTemp$ = iSymbol$ & iTemp$
    Next
End Function

[Leanna]

Вау!!! pashulka ты просто гуру и добрый человек
Буду у тебя учиться. Ты мне очень помог. Я буду это использовать.
Спасибо.