Страницы: 1
RSS
подскажите какой нужен макрос
 
Всем добрый день!  
Вопрос такой...есть база заказов, надо чтобы при клике на кнопку из базы делалась выборка по текущей дате и результат распечатывался.  
результат сохранять не надо.  
 
Понимаю что нужен макрос, а какой не знаю...не силен в VBA  
Подскажите (или ткните носом где копать...может разберусь)
 
Подобную задачу,наверное, проще решить в access
 
вот попробуйте.  
 
с печатью я сам не умею работать, запишите макродекодером распечатывание листа и замените этим строку кода  
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"  
 
на ту что у Вас показал макродекодер.  
 
 
ну еще придется напильничком наверно потом попилить разбиение на листы и пр.
 
Вот вам макрос, формирующий выборку:  
 
 
Sub test()  
   Dim sh1 As Worksheet: Set sh1 = Sheets("База")  
   Dim sh2 As Worksheet: Set sh2 = Sheets("забрать в цеху")  
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = sh1.Range(sh1.[A2], sh1.Range("A" & Rows.Count).End(xlUp))
   For Each cell In ra.Cells  
       If CDate(cell(1, 4)) = Fix(Now) Then  
           cell.Resize(, 3).Copy sh2.Range("A" & Rows.Count).End(xlUp).Offset(1)  
       End If  
   Next cell  
   sh2.Activate  
End Sub  
 
 
А вот - пример в виде файла: http://excelvba.ru/XL_Files/Sample__24-02-2010__15-04-46.zip  
 
Для распечатки надо в макрос (снизу, перед End Sub) добавить sh2.printout
 
Спасибо  
to Dophin  
все хорошо, только печатает полностью строку из базы, а надо что бы печатал то что на листе "Забрать в цеху", т.е. должна получаться выборка такого вида. Возможно исправить?  
 
to EducatedFool  
все хорошо, только в выборку на лист "Забрать в цеху" в столбце "Срок изготовления" ставит значения из столбца "Дата оформления". Возможно исправить?
 
вот исправленная версия: Sub test()  
   Dim sh1 As Worksheet: Set sh1 = Sheets("База")  
   Dim sh2 As Worksheet: Set sh2 = Sheets("забрать в цеху")  
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = sh1.Range(sh1.[A2], sh1.Range("A" & Rows.Count).End(xlUp))
   For Each cell In ra.Cells  
       If CDate(cell(1, 4)) = Fix(Now) Then  
           Union(cell(1, 1), cell(1, 2), cell(1, 4)).Copy sh2.Range("A" & Rows.Count).End(xlUp).Offset(1)  
       End If  
   Next cell  
   sh2.Activate  
End Sub  
 
 
Файл: http://excelvba.ru/XL_Files/Sample__24-02-2010__18-13-55.zip
 
Спасибо
Страницы: 1
Читают тему
Наверх
Loading...