Добрый день,сразу скажу я не силет вообще в эксле по этому прошу помощи у знающих людей. в таблицу вносится наименование оборудования и номер потом эти данные автоматом вставляются в лист "заключение и заключение телеметрия) в столбце А есть две кнопки отправляющий лист "заключения на печать" хотелось бы что бы можно было проставлять в столбце А к примеру знак + на против каждого оборудования и потом нажать кнопку печать и что бы они потом автоматом печатались. надеюсь поймете о чем я
Добрый день,сразу скажу я не силет вообще в эксле по этому прошу помощи у знающих людей. в таблицу вносится наименование оборудования и номер потом эти данные автоматом вставляются в лист "заключение и заключение телеметрия) в столбце А есть две кнопки отправляющий лист "заключения на печать" хотелось бы что бы можно было проставлять в столбце А к примеру знак + на против каждого оборудования и потом нажать кнопку печать и что бы они потом автоматом печатались. надеюсь поймете о чем яdizlike
Sub Print_() For Each a In Columns("A:A").SpecialCells(xlCellTypeConstants, 23) If a.Value = "+" Then b = a.Row With Sheets("Заключение") .Range("b20:c20") = Range("b" & b & ":c" & b).Value .PrintOut End With End If Next End Sub
[/vba]
[vba]
Код
Sub Print_() For Each a In Columns("A:A").SpecialCells(xlCellTypeConstants, 23) If a.Value = "+" Then b = a.Row With Sheets("Заключение") .Range("b20:c20") = Range("b" & b & ":c" & b).Value .PrintOut End With End If Next End Sub
думал, что вам это уже не нужно раз макрос по + перед печатью вставляет данные, добавил [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 Then b = Target.Row Sheets("Заключение").Range("b20:c20") = Range("b" & b & ":c" & b).Value Sheets("Заключение телеметрия").Range("b20:c20") = Range("b" & b & ":c" & b).Value End If End Sub
[/vba]
думал, что вам это уже не нужно раз макрос по + перед печатью вставляет данные, добавил [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 Then b = Target.Row Sheets("Заключение").Range("b20:c20") = Range("b" & b & ":c" & b).Value Sheets("Заключение телеметрия").Range("b20:c20") = Range("b" & b & ":c" & b).Value End If End Sub
Щас да,все вставляется куда надо но с 5 колонки уже при печати не проставляются наименование и номер,хотя если перейти на колонку заключения то они вставляются. upd: вообщем после теста, распечатывает всего два листа нормально остальные уже криво без наименования и номера
Щас да,все вставляется куда надо но с 5 колонки уже при печати не проставляются наименование и номер,хотя если перейти на колонку заключения то они вставляются. upd: вообщем после теста, распечатывает всего два листа нормально остальные уже криво без наименования и номераdizlike
Сообщение отредактировал dizlike - Понедельник, 16.06.2025, 14:04
я ввел 5 наименований оборудования и 5 номеров. зашел в заключения они там отображаются. проставил 5 + и нажал печать.нормально распечаталось только две позиции остальные три с пустыми колонками или в поле № оборудование написано Заключение) то ли поля съезжают то ли в коде что то не то
я ввел 5 наименований оборудования и 5 номеров. зашел в заключения они там отображаются. проставил 5 + и нажал печать.нормально распечаталось только две позиции остальные три с пустыми колонками или в поле № оборудование написано Заключение) то ли поля съезжают то ли в коде что то не тоdizlike
все так же печатает только две позиции. если вы возьмете мой изначальный файл там есть макрос который отвечает за то что с колонки "наименование оборуд и номер" если туда вбить то это переносится на лист заключения,может в этом проблема,сейчас( в моем варианте) что бы распечатать к примеру 100 позиций надо на главном листе нажимать каждый раз на наименование оборудования и потом на кнопку печать.
все так же печатает только две позиции. если вы возьмете мой изначальный файл там есть макрос который отвечает за то что с колонки "наименование оборуд и номер" если туда вбить то это переносится на лист заключения,может в этом проблема,сейчас( в моем варианте) что бы распечатать к примеру 100 позиций надо на главном листе нажимать каждый раз на наименование оборудования и потом на кнопку печать.dizlike
может еще есть у кого идеи? Имеется файл с макросом, который отвечает за то что с колонки "наименование оборуд и номер" если туда вбить то это переносится на лист заключения, в моем варианте что бы распечатать к примеру 100 позиций надо на главном листе нажимать каждый раз на наименование оборудования и потом на кнопку печать. идея в том что бы в колонке А напротив каждого наименования оборудования например проставить знак + и нажать печать что бы за раз вышло нужное колличество заключений и при этом с колонок (наименование обор. и номер) вставлялись при печати автоматически, надеюсь понятно объяснил.
может еще есть у кого идеи? Имеется файл с макросом, который отвечает за то что с колонки "наименование оборуд и номер" если туда вбить то это переносится на лист заключения, в моем варианте что бы распечатать к примеру 100 позиций надо на главном листе нажимать каждый раз на наименование оборудования и потом на кнопку печать. идея в том что бы в колонке А напротив каждого наименования оборудования например проставить знак + и нажать печать что бы за раз вышло нужное колличество заключений и при этом с колонок (наименование обор. и номер) вставлялись при печати автоматически, надеюсь понятно объяснил.dizlike
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист3.Range("B20:C20").ClearContents Лист3.Cells(20, "B").Value = .Cells(i, "B").Value Лист3.Cells(20, "C").Value = .Cells(i, "C").Value Лист3.PrintOut End If
Next i
End With
End Sub
' Лист7 (Заключение телеметрия) Sub PrintSH2() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист7.Range("B20:C20").ClearContents Лист7.Cells(20, "B").Value = .Cells(i, "B").Value Лист7.Cells(20, "C").Value = .Cells(i, "C").Value Лист7.PrintOut End If
Next i
End With
End Sub
[/vba]Возможно я тоже вас не понял, но всё же протестируйте. Удачи.
dizlike, Так что ли вам надо? [vba]
Код
Option Explicit
' Лист3 (Заключение) Sub PrintSH1() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист3.Range("B20:C20").ClearContents Лист3.Cells(20, "B").Value = .Cells(i, "B").Value Лист3.Cells(20, "C").Value = .Cells(i, "C").Value Лист3.PrintOut End If
Next i
End With
End Sub
' Лист7 (Заключение телеметрия) Sub PrintSH2() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист7.Range("B20:C20").ClearContents Лист7.Cells(20, "B").Value = .Cells(i, "B").Value Лист7.Cells(20, "C").Value = .Cells(i, "C").Value Лист7.PrintOut End If
Next i
End With
End Sub
[/vba]Возможно я тоже вас не понял, но всё же протестируйте. Удачи.MikeVol
Здравствуйте. Попробуйте печать с задержкой, макрос от Nic70y, [vba]
Код
Sub Print_() For Each a In ActiveSheet.Columns("A:A").SpecialCells(xlCellTypeConstants, 23) If a.Value = "+" Then b = a.Row With Sheets("Заключение") .Range("b20:c20") = Sheets("Лист1").Range("b" & b & ":c" & b).Value .PrintOut Application.Wait (Now + TimeValue("0:00:01")) End With End If Next a End Sub
[/vba] Если бдет также, поиграйте с временем задержки.
Здравствуйте. Попробуйте печать с задержкой, макрос от Nic70y, [vba]
Код
Sub Print_() For Each a In ActiveSheet.Columns("A:A").SpecialCells(xlCellTypeConstants, 23) If a.Value = "+" Then b = a.Row With Sheets("Заключение") .Range("b20:c20") = Sheets("Лист1").Range("b" & b & ":c" & b).Value .PrintOut Application.Wait (Now + TimeValue("0:00:01")) End With End If Next a End Sub
[/vba] Если бдет также, поиграйте с временем задержки.gling
- там две кнопки на листе Лист1. Одна для печати листа Заключение и вторая для печати листа Заключение телеметрия. И радуйтесь на выходе печатью, главное чтоб бумага была в принтере и вам шеф не дал по шапке за такие растраты. Удачи.
P.S. Ваши макросы полностью удалил, от слова все! [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Or Target.Cells.Count > 1 Then Exit Sub
Dim lastRow As Long lastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row If Target.Row <> lastRow Then Exit Sub
Application.ScreenUpdating = False Application.EnableEvents = False On Error GoTo CleanExit
With Лист3 .Range("B20").Value = Me.Cells(Target.Row, Target.Column).Value .Range("C20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 1).Value .Range("D20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 4).Value End With
With Лист7 .Range("B20").Value = Me.Cells(Target.Row, Target.Column) .Range("C20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 1).Value .Range("D20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 4).Value End With
CleanExit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba] [vba]
Код
Option Explicit
' Лист3 (Заключение) Sub PrintSH1() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист3.Range("B20:D20").ClearContents Лист3.Range("B20:D20").Value = Array(.Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "F").Value) Лист3.PrintOut End If
Next i
End With
End Sub
' Лист7 (Заключение телеметрия) Sub PrintSH2() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист7.Range("B20:D20").ClearContents Лист7.Range("B20:D20").Value = Array(.Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "F").Value) Лист7.PrintOut End If
- там две кнопки на листе Лист1. Одна для печати листа Заключение и вторая для печати листа Заключение телеметрия. И радуйтесь на выходе печатью, главное чтоб бумага была в принтере и вам шеф не дал по шапке за такие растраты. Удачи.
P.S. Ваши макросы полностью удалил, от слова все! [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Or Target.Cells.Count > 1 Then Exit Sub
Dim lastRow As Long lastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row If Target.Row <> lastRow Then Exit Sub
Application.ScreenUpdating = False Application.EnableEvents = False On Error GoTo CleanExit
With Лист3 .Range("B20").Value = Me.Cells(Target.Row, Target.Column).Value .Range("C20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 1).Value .Range("D20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 4).Value End With
With Лист7 .Range("B20").Value = Me.Cells(Target.Row, Target.Column) .Range("C20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 1).Value .Range("D20").Value = Me.Cells(Target.Row, Target.Column).Offset(0, 4).Value End With
CleanExit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba] [vba]
Код
Option Explicit
' Лист3 (Заключение) Sub PrintSH1() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист3.Range("B20:D20").ClearContents Лист3.Range("B20:D20").Value = Array(.Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "F").Value) Лист3.PrintOut End If
Next i
End With
End Sub
' Лист7 (Заключение телеметрия) Sub PrintSH2() Dim i As Long
With ThisWorkbook.Worksheets("Лист1")
Dim lastRow As Long lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "A").Value = "+" Then Лист7.Range("B20:D20").ClearContents Лист7.Range("B20:D20").Value = Array(.Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "F").Value) Лист7.PrintOut End If
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Удачи.
