Доброго времени суток! Сразу оговорюсь, я в этом деле не специалист (по специальности - врач-хирург). Задача состоит в следующем: Существует файл шаблон.xltm, содержащий множество редактируемых в последствии форм, который при поступлении пациента открывает и редактирует медсестра на посту при приеме пациента, и вносит данные пациента (ФИО, дата поступления, рожд. и так далее), в дальнейшем, после завершения редактирования шаблона, она его закрывает и макросом создается отдельный файл по номеру истории болезни в сетевую папку, откуда в дальнейшем этот файл и другие его листы редактируются доктором согласно необходимости.... Для создания статистики, необходимо, что эти данные (ФИО, дата рожд, поступления и так далее по столбцу) при первичном редактировании шаблона копировалась в отдельный файл в новую строчку каждый раз, когда завершается редактирование и закрывается шаблон, чтобы при внесении новой информации создавалась новая строчка в файле куда сохранять.xlsx Заранее благодарен за ваши ответы!
От 17.08.2017 г.
За здоровую критику, конечно, спасибо, с места пока что не сдвинулся ввиду отсутствия времени.
Прикрепил файл с макросом автосохранения, к которому и хотел бы допилить сохранение не только в отдельный файл (см. макрос, но и копирование вновь введенных данных в "отдельный файл в новую строчку каждый раз, когда завершается редактирование и закрывается шаблон, чтобы при внесении новой информации создавалась новая строчка в файле куда сохранять.xlsx" как уже писалось выше.
P.S. файл шаблона больше 100 Кб, поэтому в архиве.
Чем не выгода? Но, собственно, я не об этом. В этой ветке форума помогают по КОНКРЕТНЫМ вопросам. Начните что-то делать сами (писАть макрос, например) и по мере продвижения задавайте в этой ветке конкретные вопросы, по конкретному коду. Хотя и здесь бывает, что решают комплексные задачи. Если интересный вопрос. Или в качестве практики
Согласие есть продукт при полном непротивлении сторон
Реализован вывод постфактум информации в отдельный лист макросом, назначенным на отдельную кнопку:
Скрытый текст
Код
Sub Consolidated_Range_of_Books_and_Sheets()
Dim iBeginRange As Object, lCalc As Long, lCol As Long
Dim oAwb As String, sCopyAddress As String, sSheetName As String
Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
Dim wbAct As Workbook
Dim bPasteValues As Boolean
On Error Resume Next
'Выбираем диапазон выборки с книг
Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
"1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
'для указания диапазона без диалогового окна:
'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
'Если диапазон не выбран - завершаем процедуру
If iBeginRange Is Nothing Then Exit Sub
'Указываем имя листа
'Допустимо указывать в имени листа символы подставки ? и *.
'Если указать только * то данные будут собираться со всех листов
sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
'Если имя листа не указано - данные будут собраны со вех листов
If sSheetName = "" Then sSheetName = "*"
On Error GoTo 0
'Запрос - вставлять на результирующий лист все данные
'или только значения ячеек (без формул и форматов)
bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes)
'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги)
If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
If VarType(avFiles) = vbBoolean Then Exit Sub
bPolyBooks = True
lCol = 1
Else
avFiles = Array(ThisWorkbook.FullName)
End If
'отключаем обновление экрана, автопересчет формул и отслеживание событий
'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
With Application
lCalc = .Calculation
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
End With
'создаем новый лист в книге для сбора
Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
'если нужно сделать сбор данных на новый лист книги с кодом
'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
'цикл по книгам
For li = LBound(avFiles) To UBound(avFiles)
If bPolyBooks Then
Set wbAct = Workbooks.Open(Filename:=avFiles(li))
Else
Set wbAct = ThisWorkbook
End If
oAwb = wbAct.Name
'цикл по листам
For Each wsSh In wbAct.Sheets
If wsSh.Name Like sSheetName Then
'Если имя листа совпадает с именем листа, в который собираем данные
'и сбор идет только с активной книги - то переходим к следующему листу
If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
With wsSh
Select Case iBeginRange.Count
Case 1 'собираем данные начиная с указанной ячейки и до конца данных
lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
iLastColumn = .Cells.SpecialCells(xlLastCell).Column
sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
Case Else 'собираем данные с фиксированного диапазона
sCopyAddress = iBeginRange.Address
End Select
lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
'вставляем имя книги, с которой собраны данные
If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = oAwb
If bPasteValues Then 'если вставляем только значения
.Range(sCopyAddress).Copy
wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues
Else
.Range(sCopyAddress).Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
End If
End With
End If
NEXT_:
Next wsSh
If bPolyBooks Then wbAct.Close False
Next li
With Application
.ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
End With
End Sub
В принципе данный макрос полностью устраивает, но иногда бывают нестыковки в статистике, выдаваемой другими службами и нашей, так как бывают случаи, когда файлы случайно (или намеренно удаляются). Вот и требуется, чтобы был двойной слепой контроль и учет всех возможных вариантов.