Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Автоматическая Нумерация документа при печати
 
 Всем привет
если кто то знает может подсказать как сделать так чтобы после макроса( макроса для печати ) номер документа автоматически плюсовал +1
***например  как сделать чтобы номер сейчас 372 а после печати стал 373???
заранее всем спасибо
 
 
Храните номер в CustomDocumentProperties и каждый раз по событию Workbook_BeforePrint изменяйте его как Вам угодно. Если же у Вас номер в отдельной ячейке(без текста), тогда просто по событию Workbook_BeforePrint прибавляйте единицу к числу в ячейке.
Изменено: kuklp - 13 Май 2017 11:54:12
Я сам - дурнее всякого примера! ...
 
Спасибо большое!!)
понял
 
kuklp,Здравствуйте, я по тому же вопросу, только не могу понять как это сделать? Где эта часть "CustomDocumentProperties" находится? Подскажите пожалуйста. Можете мне скинуть этот макрос?
Изменено: Шахин - 13 Дек 2017 08:43:16
По почерку принтера можно судить о том, как нервничает компьютер
 
Свойство Workbook.CustomDocumentProperties
Согласие есть продукт при полном непротивлении сторон.
 
Sanja,Спасибо! Только вот один вопрос. Как тут выбрать именно ту ячейку которую нужно последовательно нумеровать?
Код
rw = 1
Worksheets(1).Activate
For Each p In ActiveWorkbook.CustomDocumentProperties
    Cells(rw, 1).Value = p.Name
    Cells(rw, 2).Value = p.Value
    rw = rw + 1
Next
По почерку принтера можно судить о том, как нервничает компьютер
 
Если Вы хотите менять значение в ЯЧЕЙКЕ, то Вам нужен совет 2 от kuklp,
Цитата
kuklp написал: Если же у Вас номер в отдельной ячейке(без текста), тогда просто по событию Workbook_BeforePrint прибавляйте единицу к числу в ячейке.
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, У меня в ячейке С2 "OD000001". Никак не могу это сделать в макросе.

П.С. Можно и без букв. Главное чтобы при каждом печати номер менялся.
Изменено: Шахин - 13 Дек 2017 09:30:21
По почерку принтера можно судить о том, как нервничает компьютер
 
Что-то типа такого
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    n = Val(Mid(Worksheets("MMO").Range("C2"), 3)) + 1
    Worksheets("MMO").Range("C2") = "OD" & Format(n, "000000")
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, Не получается. Когда даю на печать номер остаётся всё тот же OD000001
По почерку принтера можно судить о том, как нервничает компьютер
 
Этот код нужно вставить в модуль ЭтаКнига
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, Работает!  :)  Только вот одно "Но". Когда я даю на печать по команде сразу 10 страниц, макрос печатает на всех 10 листах "OD000002". А мне по работе надо дать на печать сразу 1000 с последовательностью копий печати и каждая с последовательной нумерацией. Надеюсь и это возможно.
Изменено: Шахин - 13 Дек 2017 10:31:30
По почерку принтера можно судить о том, как нервничает компьютер
 
Фукнция отличная, только вот приходится каждый раз нажимать на контр. прнт..  
По почерку принтера можно судить о том, как нервничает компьютер
 
Цитата
Шахин написал:  каждый раз нажимать на контр. прнт..  
... а ведь так хочется "по щучьему велению, по моему хотению" :)
 
vikttur, и это значит? Пипец.
Изменено: Шахин - 13 Дек 2017 15:35:40
По почерку принтера можно судить о том, как нервничает компьютер
 
Вариант. В Общий модуль
Код
Sub CopyPrint()
On Error Resume Next
iCopy = Application.InputBox("Введите количество копий:", "Печать", 1, Type:=1)
Application.ScreenUpdating = False
If IsNumeric(iCopy) And iCopy > 0 Then
    With Worksheets("MMO")
        For I = 0 To iCopy - 1
            .Range("C2") = "OD" & Format(Val(Mid(.Range("C2"), 3)) + I, "000000")
            .PrintOut
        Next
    End With
End If
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, Спасибо! Когда я задаю число копий 10 при начальном старте 000001, то нумерация идёт почему то до 000046.
По почерку принтера можно судить о том, как нервничает компьютер
 
Код
Sub CopyPrint()
On Error Resume Next
iCopy = Application.InputBox("Введите количество копий:", "Печать", 1, Type:=1)
Application.ScreenUpdating = False
If IsNumeric(iCopy) And iCopy > 0 Then
    With Worksheets("MMO")
        For I = 0 To iCopy - 1
            .PrintOut
        Next
        .Range("C2") = "OD" & Format(Val(Mid(.Range("C2"), 3)) + I, "000000")
    End With
End If
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, Браво!  :D  Спасибо! Респект!
По почерку принтера можно судить о том, как нервничает компьютер
 
Sanja, Увы опять не получается. Когда я даю на печать поочередно, то принтер печатает все копии с одной и той же нумерацией, только в ячейке в конце меняется значение.
Например: у меня числовой порядок начинается от OD000001, даю на печать число копий (5), в итоге печатается 5 листов с номером OD000001, а в ячейке числовой порядок уже показывает OD000006.
П.С. В параграфе 17 формула печатает последовательно заданным копиям.
Изменено: Шахин - 14 Дек 2017 17:03:35
По почерку принтера можно судить о том, как нервничает компьютер
 
Код
Sub CopyPrint()
On Error Resume Next
iCopy = Application.InputBox("Введите количество копий:", "Печать", 1, Type:=1)
Application.ScreenUpdating = False
If IsNumeric(iCopy) And iCopy > 0 Then
    With Worksheets("MMO")
        For I = 1 To iCopy
            .PrintOut
            iNum = CDbl(Mid(.Range("C2"), 3)) + I
            .Range("C2").Value = "OD" & Format(iNum, "000000")
        Next
    End With
End If
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, Не получилось. Дал 10 копий от OD000001,

Печатает такой последовательностью:
OD000001
OD000002
OD000004
OD000007
OD0000011
 и т.д.
в конце в ячейке OD000056
По почерку принтера можно судить о том, как нервничает компьютер
 
:D . Опечатка. Вместо единицы i прибавлял
Код
Sub CopyPrint()
On Error Resume Next
iCopy = Application.InputBox("Введите количество копий:", "Печать", 1, Type:=1)
Application.ScreenUpdating = False
If IsNumeric(iCopy) And iCopy > 0 Then
    With Worksheets("MMO")
        For I = 1 To iCopy
            .PrintOut
            .Range("C2").Value = "OD" & Format(CDbl(Mid(.Range("C2"), 3)) + 1, "000000")
        Next
    End With
End If
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja,Спасибо большое! :D  
По почерку принтера можно судить о том, как нервничает компьютер
 
Sanja, не перестаю удивляться гениальности! Спасибо!
Лишь стремясь к невозможному, можно достичь максимального.
 
Всем привет. Дорогие форумчане искал в интернете, но почти здесь нашел нормальные ответы. Вот и решил здесь написать.
Проблема такая вставляю макрос но не получается (чайник по темам макрос).

Добавляю екзель для примера. Нужно чтоб номер перед "путевой лист" при печати увеличивался на один и сохранялся на последнем.

Заранее спасибо за ответ.
Страницы: 1
Читают тему (гостей: 1)
Наверх