Добрый день еще раз!!! Оператор составляет заявку через UseForm и после того как заявка сформирована. Оператор нажимает кнопку "Скопировать данные в журнал заявок" и все данные копируются на лист в таблицу "Журнал заявок" (с каждым разом пополняя этими данными таблицу). Я вроде бы нашел код который мне должен был помочь (((( но я или ошибся или же я не верно все отредактировал [vba]
Код
Private Sub CommandButton4_Click()
Dim shSheet_("Заявка МТ-1 для печати") As Excel.Worksheet, shSheet_("Журнал заявок") As Excel.Worksheet Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Указываем, с какой по какую строку двигаться по первому листу 'по столбцу "A". lStartSheet_("Заявка МТ-1 для печати") = 6 lEndSheet_("Заявка МТ-1 для печати") = 20
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = 2
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheet_("Заявка МТ-1 для печати") = Worksheets("Заявка МТ-1 для печати") Set shSheet_("Журнал заявок") = Worksheets("Журнал заявок")
'Двигаем по первому листу по столбцу "A". For i = lStartSheet_("Заявка МТ-1 для печати") To lEndSheet_("Заявка МТ-1 для печати") Step 1 'Если в ячейке есть число "1". If shSheet_("Заявка МТ-1 для печати").Cells(i, "A").Value = 1 Then 'Переносим данные на второй лист. shSheet_("Журнал заявок").Cells(lLastRow, "B").Value = shSheet_("Заявка МТ-1 для печати").Cells(i, "J").Value 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
Next i
[/vba] Хотелось бы чтоб после того как данные скопировались сама заявка очищалась от данных и всплывало сообщение "Данные скопированы. Заявка очищена" Помогите подскажите пожалуйста!!! Заранее спасибо.
Добрый день еще раз!!! Оператор составляет заявку через UseForm и после того как заявка сформирована. Оператор нажимает кнопку "Скопировать данные в журнал заявок" и все данные копируются на лист в таблицу "Журнал заявок" (с каждым разом пополняя этими данными таблицу). Я вроде бы нашел код который мне должен был помочь (((( но я или ошибся или же я не верно все отредактировал [vba]
Код
Private Sub CommandButton4_Click()
Dim shSheet_("Заявка МТ-1 для печати") As Excel.Worksheet, shSheet_("Журнал заявок") As Excel.Worksheet Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Указываем, с какой по какую строку двигаться по первому листу 'по столбцу "A". lStartSheet_("Заявка МТ-1 для печати") = 6 lEndSheet_("Заявка МТ-1 для печати") = 20
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = 2
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheet_("Заявка МТ-1 для печати") = Worksheets("Заявка МТ-1 для печати") Set shSheet_("Журнал заявок") = Worksheets("Журнал заявок")
'Двигаем по первому листу по столбцу "A". For i = lStartSheet_("Заявка МТ-1 для печати") To lEndSheet_("Заявка МТ-1 для печати") Step 1 'Если в ячейке есть число "1". If shSheet_("Заявка МТ-1 для печати").Cells(i, "A").Value = 1 Then 'Переносим данные на второй лист. shSheet_("Журнал заявок").Cells(lLastRow, "B").Value = shSheet_("Заявка МТ-1 для печати").Cells(i, "J").Value 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
Next i
[/vba] Хотелось бы чтоб после того как данные скопировались сама заявка очищалась от данных и всплывало сообщение "Данные скопированы. Заявка очищена" Помогите подскажите пожалуйста!!! Заранее спасибо.lebensvoll
Manyasha, я же писал (((( что данный код взял (через поиск, что нашел), хотел его под себя подправить как понял. Но чем дальше я понимал (что ни черта не понимаю) еще больше наделал там такого что просто ОЧУМЕТЬ ((((
Manyasha, я же писал (((( что данный код взял (через поиск, что нашел), хотел его под себя подправить как понял. Но чем дальше я понимал (что ни черта не понимаю) еще больше наделал там такого что просто ОЧУМЕТЬ ((((lebensvoll
сама заявка очищалась от данных и всплывало сообщение
так у Вас форма выгружается после добавления данных, а при новом вызове все очищено. а для сообщения добавьте строку в конец процедуры Butt_ok_Click() [vba]
сама заявка очищалась от данных и всплывало сообщение
так у Вас форма выгружается после добавления данных, а при новом вызове все очищено. а для сообщения добавьте строку в конец процедуры Butt_ok_Click() [vba]
lebensvoll, Надо подгонять к рабочему файлу, но общее поправил [vba]
Код
Private Sub CommandButton4_Click()
Dim shSheetf As Worksheet Dim shSheett As Worksheet ' Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheetf = Worksheets("Заявка МТ-1 для печати") Set shSheett = Worksheets("Журнал заявок")
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. For x = 2 To 8 shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
Next i MsgBox "Данные перенесены"
End Sub
[/vba]
lebensvoll, Надо подгонять к рабочему файлу, но общее поправил [vba]
Код
Private Sub CommandButton4_Click()
Dim shSheetf As Worksheet Dim shSheett As Worksheet ' Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheetf = Worksheets("Заявка МТ-1 для печати") Set shSheett = Worksheets("Журнал заявок")
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. For x = 2 To 8 shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
так у Вас форма выгружается после добавления данных, а при новом вызове все очищено.
Я просто создал форму для того чтоб оператор с ее помощью смог заполнять саму заявку. После того как он заполнил ее (будет там 10-ть; 15-ть или же 20-ть позиций не важно) и как только он ее заполнил он нажимает кнопку "скопировать данные в журнал" и все эти позиции сохраняются в лист "Журнала заявок" а сама заявка очистилась. И готова будет для составления новой заявки (заявки на поставку инертных материалов составляется и подается раз в неделю или в ПН или ВТ). Только прежде чем оператор нажмет кнопку "сохранить данные в в журнал" он должен будет ее распечатать (я правда нашел код для распечатывания и предварительного просмотра [vba]
Код
Private Sub CommandButton2_Click() 'Код для печати заявки ActiveWindow.Application.ActiveSheet.PrintPreview ActiveWindow.Application.ActiveSheet.PrintOut From:=1, To:=1, Copies:=1 End Sub
[/vba] а затем он должен будет сохранить ее в ПДФ я в принципе тож нашел данный код но пока что в нем еще не сильно разобрался (там нужно прописать куда его сохранять :-( ) [vba]
Код
Private Sub CommandButton3_Click() 'код для сохранения заявки в PDF Sheets(Array("Заявка МТ-1 для печати")).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "N:\\morton\user\Группы\ДПром\Сохранить в пдф.pdf", Quality _ :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True End Sub
[/vba] Возможно я вновь не верно что то прописываю (когда переделываю) но пока не вникал в него... И уж потом оператор только жмет кнопку "сохранить данные в журнал" sboy, СПАСИБО ОГРОМНОЕ!!! Ваш код сработал как нужно. Я сижу сравниваю ваш код со своим и понимаю что я был в очередной раз близок к истине ((((( но все же команды (как их еще назвать: процедуры, скорее всего из за не до понимания. творю чудовищные ошибки) Хотелось уточнить лишь данный код сработает для всей записи по заявке (будет там не одна запись а предположим 10-ть или 15-ть)??? А также последующие данные (составленной заявки будут записываться ниже предыдущих или же как)??? [vba]
Код
lStartSheet = 6
[/vba] Вот тут вот как я понял чтоб записывались данные в 6-ю строку листа "Журнала заявок". Я его изменил чтоб не в 6-ю а со 2-й начал.... Правильно!?
Udik,
Цитата
так у Вас форма выгружается после добавления данных, а при новом вызове все очищено.
Я просто создал форму для того чтоб оператор с ее помощью смог заполнять саму заявку. После того как он заполнил ее (будет там 10-ть; 15-ть или же 20-ть позиций не важно) и как только он ее заполнил он нажимает кнопку "скопировать данные в журнал" и все эти позиции сохраняются в лист "Журнала заявок" а сама заявка очистилась. И готова будет для составления новой заявки (заявки на поставку инертных материалов составляется и подается раз в неделю или в ПН или ВТ). Только прежде чем оператор нажмет кнопку "сохранить данные в в журнал" он должен будет ее распечатать (я правда нашел код для распечатывания и предварительного просмотра [vba]
Код
Private Sub CommandButton2_Click() 'Код для печати заявки ActiveWindow.Application.ActiveSheet.PrintPreview ActiveWindow.Application.ActiveSheet.PrintOut From:=1, To:=1, Copies:=1 End Sub
[/vba] а затем он должен будет сохранить ее в ПДФ я в принципе тож нашел данный код но пока что в нем еще не сильно разобрался (там нужно прописать куда его сохранять :-( ) [vba]
Код
Private Sub CommandButton3_Click() 'код для сохранения заявки в PDF Sheets(Array("Заявка МТ-1 для печати")).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "N:\\morton\user\Группы\ДПром\Сохранить в пдф.pdf", Quality _ :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True End Sub
[/vba] Возможно я вновь не верно что то прописываю (когда переделываю) но пока не вникал в него... И уж потом оператор только жмет кнопку "сохранить данные в журнал" sboy, СПАСИБО ОГРОМНОЕ!!! Ваш код сработал как нужно. Я сижу сравниваю ваш код со своим и понимаю что я был в очередной раз близок к истине ((((( но все же команды (как их еще назвать: процедуры, скорее всего из за не до понимания. творю чудовищные ошибки) Хотелось уточнить лишь данный код сработает для всей записи по заявке (будет там не одна запись а предположим 10-ть или 15-ть)??? А также последующие данные (составленной заявки будут записываться ниже предыдущих или же как)??? [vba]
Код
lStartSheet = 6
[/vba] Вот тут вот как я понял чтоб записывались данные в 6-ю строку листа "Журнала заявок". Я его изменил чтоб не в 6-ю а со 2-й начал.... Правильно!?lebensvoll
Вот тут вот как я понял чтоб записывались данные в 6-ю строку листа "Журнала заявок". Я его изменил чтоб не в 6-ю а со 2-й начал.... Правильно!?
нет, 6 - это начальная строка Worksheets("Заявка МТ-1 для печати") [vba]
Код
'Указываем, с какой строки начать вставлять данные на второй лист(Worksheets("Журнал заявок")) lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
Вот тут вот как я понял чтоб записывались данные в 6-ю строку листа "Журнала заявок". Я его изменил чтоб не в 6-ю а со 2-й начал.... Правильно!?
нет, 6 - это начальная строка Worksheets("Заявка МТ-1 для печати") [vba]
Код
'Указываем, с какой строки начать вставлять данные на второй лист(Worksheets("Журнал заявок")) lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
sboy, я понял когда еще раз посидел и сгруппировал данные что тут указывается таблица на листе "Заявка МТ-1" , простите что поспешил. Но все же смотрите что получается. В файле я набросал примерный список предыдущей заявки и после того как вы нажмете кнопку "Сохранить данные в журнал" все срабатывает (((( но с одной не точностью. № п/п почему то остается и не переносится ((((( также остается запись дата (((( скорее всего потому что макрос натыкается на пустые ячейки и он дату уже не цепляет (((( а хотелось чтоб дата также переносилась в таблицу (((( Это для того что потом я начну делать таблицу для руководства ((((( где они решили отслеживать что они заказали что им привезли и по выбранному поставщику (ОДНИМ СЛОВОМ ПРИКИНУТЬ ПЛАН_ФАКТ) поставок и заявок.... КАК ЕЩЕ МНОГО то сделать нужно ((((( аааааааааааа
sboy, я понял когда еще раз посидел и сгруппировал данные что тут указывается таблица на листе "Заявка МТ-1" , простите что поспешил. Но все же смотрите что получается. В файле я набросал примерный список предыдущей заявки и после того как вы нажмете кнопку "Сохранить данные в журнал" все срабатывает (((( но с одной не точностью. № п/п почему то остается и не переносится ((((( также остается запись дата (((( скорее всего потому что макрос натыкается на пустые ячейки и он дату уже не цепляет (((( а хотелось чтоб дата также переносилась в таблицу (((( Это для того что потом я начну делать таблицу для руководства ((((( где они решили отслеживать что они заказали что им привезли и по выбранному поставщику (ОДНИМ СЛОВОМ ПРИКИНУТЬ ПЛАН_ФАКТ) поставок и заявок.... КАК ЕЩЕ МНОГО то сделать нужно ((((( ааааааааааааlebensvoll
'Перносим данные на второй лист. For x = 2 To 8 'вот здесь мы берем данные с 2 по 8 столбец листа Заявка и переносим на лист Журнал с 4 по 10 столбец shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x
[/vba]
lebensvoll, в таблице на листе "Заявка МТ-1" нет даты для каждой записи, поэтому я переносил данные начиная с Организации
'Перносим данные на второй лист. For x = 2 To 8 'вот здесь мы берем данные с 2 по 8 столбец листа Заявка и переносим на лист Журнал с 4 по 10 столбец shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x
Udik, да не код от sboy, сработал на ура!!! Лишь с несколькими не доработками
Цитата
№ п/п почему то остается и не переносится ((((( также остается запись дата (((( скорее всего потому что макрос натыкается на пустые ячейки и он дату уже не цепляет (((( а хотелось чтоб дата также переносилась в таблицу ((((
Udik, да не код от sboy, сработал на ура!!! Лишь с несколькими не доработками
Цитата
№ п/п почему то остается и не переносится ((((( также остается запись дата (((( скорее всего потому что макрос натыкается на пустые ячейки и он дату уже не цепляет (((( а хотелось чтоб дата также переносилась в таблицу ((((
'Перносим данные на второй лист. For x = 2 To 17 shSheett.Cells(lLastRow, x + 1).Value = shSheetf.Cells(i, x).Value 'вот здесь мы берем данные с 2 по 8 столбец листа Заявка и переносим на лист Журнал с 4 по 10 столбец shSheetf.Cells(i, x).ClearContents Next x
[/vba] Дата убежала на другой лист. А почему же тогда № п/п остался!? И я так понял что он копирует как есть [img][/img] Но на нужный нам лист перенеслись данные также не корректно ((((
sboy, да я поменял [vba]
Код
'Перносим данные на второй лист. For x = 2 To 17 shSheett.Cells(lLastRow, x + 1).Value = shSheetf.Cells(i, x).Value 'вот здесь мы берем данные с 2 по 8 столбец листа Заявка и переносим на лист Журнал с 4 по 10 столбец shSheetf.Cells(i, x).ClearContents Next x
[/vba] Дата убежала на другой лист. А почему же тогда № п/п остался!? И я так понял что он копирует как есть [img][/img] Но на нужный нам лист перенеслись данные также не корректно ((((lebensvoll
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. For x = 1 To 17 shSheett.Cells(lLastRow, x + 1).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
[/vba] и все отлично получилось )))) дата перенеслась и № п/п тоже но все одно на листе журнал заявок (((( не корректно (((( [img][/img]
Сделал так вот [vba]
Код
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. For x = 1 To 17 shSheett.Cells(lLastRow, x + 1).Value = shSheetf.Cells(i, x).Value shSheetf.Cells(i, x).ClearContents Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
[/vba] и все отлично получилось )))) дата перенеслась и № п/п тоже но все одно на листе журнал заявок (((( не корректно (((( [img][/img]lebensvoll
Dim shSheetf As Worksheet Dim shSheett As Worksheet ' Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheetf = Worksheets("Заявка МТ-1 для печати") Set shSheett = Worksheets("Журнал заявок")
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value shSheett.Cells(lLastRow, 3).Value = shSheetf.Cells(i, 17).Value For x = 2 To 8 shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
Next i Range(Cells(6, 1), Cells(lEndSheet, 17)).ClearContents
MsgBox "Данные перенесены"
End Sub
[/vba]
lebensvoll, Увидел где у Вас дата))) [vba]
Код
Private Sub CommandButton4_Click()
Dim shSheetf As Worksheet Dim shSheett As Worksheet ' Dim lStartSheet_("Заявка МТ-1 для печати") As Long, lEndSheet_("Заявка МТ-1 для печати") As Long Dim lLastRow As Long Dim i As Long
'Даём листам имена "("Заявка МТ-1 для печати")" и "shSheet_("Журнал заявок")", 'чтобы было удобнее писать код. Set shSheetf = Worksheets("Заявка МТ-1 для печати") Set shSheett = Worksheets("Журнал заявок")
'Указываем, с какой строки начать вставлять данные на второй лист. lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
'Двигаем по первому листу по столбцу "A". For i = lStartSheet To lEndSheet If Not shSheetf.Cells(i, 2).Value = Empty Then 'Перносим данные на второй лист. shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value shSheett.Cells(lLastRow, 3).Value = shSheetf.Cells(i, 17).Value For x = 2 To 8 shSheett.Cells(lLastRow, x + 2).Value = shSheetf.Cells(i, x).Value Next x 'Изменяем переменную "lLastRow", 'чтобы данные уже вставлять в следующую строку. lLastRow = lLastRow + 1 End If
Next i Range(Cells(6, 1), Cells(lEndSheet, 17)).ClearContents
sboy, Вы просто ГЕНИЙ да все верно и прям на ура!!! Сейчас попробую куда он будет вносить данные если оператор будет формировать новую заявку. Отпишусь если что. ВЫ УЖ МЕНЯ ПРОСТИТЕ ПОЖАЛУЙСТА если что не так, но я честно стараюсь вникнуть но очень сложно ((((. И еще один вопрос а почему он на лист Журнала заявок вставляет также в 6-ю ячейку а не в первую (((( это потому что в коде у нас указана 6 но она ведь для листа Заявка МТ-1 [img][/img]
sboy, Вы просто ГЕНИЙ да все верно и прям на ура!!! Сейчас попробую куда он будет вносить данные если оператор будет формировать новую заявку. Отпишусь если что. ВЫ УЖ МЕНЯ ПРОСТИТЕ ПОЖАЛУЙСТА если что не так, но я честно стараюсь вникнуть но очень сложно ((((. И еще один вопрос а почему он на лист Журнала заявок вставляет также в 6-ю ячейку а не в первую (((( это потому что в коде у нас указана 6 но она ведь для листа Заявка МТ-1 [img][/img]lebensvoll
sboy, понял нужно тогда убрать заливки блин как это все сложно просто ЖЕСТЬ как вы столько в голове держите.... На этом форуме походу в шахматы лучше не садиться играть ))))) как и в карты.... Спасибо еще раз за ваше терпение, наставления, понимание, отзывчивость и ПОМОЩЬ!!! А также всем кто принимал участие
sboy, понял нужно тогда убрать заливки блин как это все сложно просто ЖЕСТЬ как вы столько в голове держите.... На этом форуме походу в шахматы лучше не садиться играть ))))) как и в карты.... Спасибо еще раз за ваше терпение, наставления, понимание, отзывчивость и ПОМОЩЬ!!! А также всем кто принимал участиеlebensvoll