вопрос о циклах

[alexsamurai]

Коллеги, добрый день!
Есть таблица сотрудников которым нужна доверенность: фамилия, телефон и т.д.
Есть доверенности на этих сотрудников в формате .xls, которые находятся в папке Х.
Нужно чтобы при нажатии кнопки Excel, проверял столбец, например, А4 считывал фамилию и по этой информации открывал одноименный файл, распечатовал его, сохранял и закрывал. Потом проверял А5, А6 и т.д.

LResult = VBA.Trim(Range("А4"))
ChDir "Х:\Доверенность"
Workbooks.Open Filename:="Х:\Доверенность\" & LResult & ".xls"
ActiveWindow.SelectedSheets.PrintOu t Copies:=1
Workbooks(LResult & ".xls").Close savechanges:=True

А на цикле, что то меня заклинило. Подскажите пожалуйста.

[IgorGO]

попробуйте так:

  For r = 4 To Cells(4, 1).End(xlDown).Row
    LResult = VBA.Trim(cells(r,1))
    Workbooks.Open Filename:="Х:\Доверенность\" & LResult & ".xls"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Workbooks(LResult & ".xls").Close savechanges:=True 
  Next

[EducatedFool]

Можно попробовать примерно так:

    Path = "Х:\Доверенность\###.xls"

    Dim cell As Range, wb As Workbook
    Set cell = [a4] ' первая ячейка
    While Len(cell.Value) > 0 ' перебираем непустые ячейки
        Filename = Replace(Path, "###", Trim$(cell.Value)) ' формируем полный путь к файлу (заменяя ### на фамилию)
        
        If Dir(Filename) <> "" Then    ' файл существует
            Set wb = Workbooks.Open(Filename, , True) ' открываем файл в режиме ТОЛЬКО ЧТЕНИЕ
            wb.PrintOut ' выводим документ на печать
            wb.Close False    ' закрываем файл без сохранения изменений
        End If
        
        Set cell = cell.Offset(1) ' переходим к следующей ячейке
    Wend

Код не проверял, так что возможны ошибки.

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

[tolikman]

или так

sub openAndPrint()
dim parSHT as workSheet
dim opensBook as workBook
dim i as integer
dim col as integer
set parSHT = ActiveSheet
col = 1 'Столбец с фамилиями A=1, B=2, C=3 ......
i=1 'строка с которой надо начать сканирование фамилий
do while parSHT.cells(i,col)<>empty 'здесь начинается цикл
  set opensBook = workbooks.open FileName:="X:\Доверенность\" & parSHT.cells(i,col) & ".xls"
  opensBook.Sheets("имя листа для печати").PrintOut Copies:=1 'впринципе можно заменить на твой вариант   opensBook.SelectedSheets.PrintOut Copies:=1
  opensBook.Save 'Сохраняет
  opensBook.Saved=True 'Говорит приложению, мол файл был сохранен, и excel у пользователя не спросит сохранять или нет
  opensBook.Close False
  i=i+1
loop 'конец цикла

[EducatedFool]

Нужно чтобы при нажатии кнопки Excel, проверял столбец, например, А4 считывал фамилию и по этой информации открывал одноименный файл, распечатовал его, сохранял и закрывал.

Далеко не самый оптимальный способ решения задачи.

Гораздо проще сделать так:

В тот же файл, гда у Вас столбцы с фамилиями, добавляем лист с шаблоном доверенности.
Все изменяемые поля шаблона (там где фамилия и другие реквизиты) заполняются формулами - формулы подставляют в ячейки значения из строк листа с данными.

На кого в данный момент заполнена доверенность, определяется значением какой-либо одной ячейки.
(если в ячейке стоит 1, то доверенность заполнена на Иванова - так как его данные в первой строке, если в ячейке 2 - то на Сидорова, и т.д.)

Тогда распечатка доверенностей значительно упрощается.
Не надо открывать множество книг - на это уходит время, да и возможны ошибки (файл повреждён, отсутствует, переименован, и т.п.)

А в предложенном мной варианте всё просто: в цикле меняем значение в одной ячейке (1, 2, 3 и т.д.) и выводим на печать лист шаблона.
И каждый раз доверенность у нас печатается на другого человека.

У такого подхода есть ещё куча преимуществ.

[alexsamurai]

Во-первых спасибо, что откликнулись.
А теперь по порядку.
Да, в доверенности сохраняется дата и порядковый номер доверенности

Private Sub Workbook_Open()
Range("E1") = Range("E1") + 1
End Sub

По поводу все в одном: в доверенности нужно вводить паспорт, а в таблице этого не нужно. В таблице просто информация на сегодняшний день.

[alexsamurai]

Сообщение от IgorGO

попробуйте так:

  For r = 4 To Cells(4, 1).End(xlDown).Row
    LResult = VBA.Trim(cells(r,1))
    Workbooks.Open Filename:="Х:\Доверенность\" & LResult & ".xls"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Workbooks(LResult & ".xls").Close savechanges:=True 
  Next

IgorGO просто вставил Ваш код и он не заработал.
цикл пошел от А4 и до пустой строки, проверяя все ячейки?

[IgorGO]

да, предполагается за А4 последовательный ряд с данными. Первая пустая ячейка в колонке А оборвет перемещение вниз. Я не знаю как ваши данные организованы, увы...
Закрутите цикл от 4 до Х

[alexsamurai]

Сообщение от IgorGO

попробуйте так:

  For r = 4 To Cells(4, 1).End(xlDown).Row
    LResult = VBA.Trim(cells(r,1))
    Workbooks.Open Filename:="Х:\Доверенность\" & LResult & ".xls"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Workbooks(LResult & ".xls").Close savechanges:=True 
  Next

Первая строчка работает, начинает 4строка 1столбец. А дальше он не проверяет данные, т.е. он печатает ту же доверенность: от 4строки 1 столбца, до пустой строки. Если у меня в столбце А, 3 разные фамилии он все равно печатает доверенность с первой фамилией, но 3 раза.
Получается, что то не так во второй строчке кода.

[alexsamurai]

Все спасибо ВСЕМ.
IgorGO отдельное спасибо, сделал по твоему примеру.