Копируем данные из программы в MS Office Excel

' ==================== Нажатие кнопки "Перенести в Excel" Private Sub ToExcelButton_Click() Dim filename As String Dim path As String Dim name As String Dim i As Integer Dim j As Integer Dim res Dim kol_cols As Integer Dim kol_rows As Integer Dim ex As Excel.Application Dim wbs As Excel.Workbooks Dim wb As Excel.Workbook Dim ws As Excel.Worksheet   path = "c:\"                       ' Путь к файлу name = "prot_01.xls"               ' Имя файла filename = path + name             ' Полное имя файла kol_rows = 10 kol_cols = 3   InputFileName: filename = InputBox("Введите имя файла Excel для сохранения в него результатов:", "Сохранение файла...", filename) If filename = "" Then Exit Sub     ' Если имя файла - пустое, то выходим из процедуры   If Dir(filename) <> "" Then        ' Если такой файл уже существует...     res = MsgBox("Перезаписать существующий файл?", vbYesNoCancel + vbQuestion, "Файл с таким именем уже существует")     If res = vbNo Then             ' Если пользователь нажал "Нет" (не перезаписывать файл)         GoTo InputFileName     End If     If res = vbCancel Then         ' Если пользователь нажал "Отмена"...         Exit Sub                   ' ...выходим из процедуры     End If End If   Screen.MousePointer = 11           ' Делаем из курсора мыши песочные часы   ' Предполагается наличие пустого файла prot.xls, поэтому... FileCopy (path + "prot.xls"), filename ' ...копируем пустой файл prot.xls в файл, заданный пользователем   On Error Resume Next                           ' Игнорировать ошибки Set ex = GetObject(, "Excel.Application")      ' Получаем объект Excel If err.Number <> 0 Then                        ' Если Excel не запущен...     Set ex = CreateObject("Excel.Application") ' Создаем объект Excel End If err.Clear                                      ' Очищаем объект Err ex.Visible = False Set wbs = ex.Workbooks                         ' Получаем коллекцию книг Set wb = ex.Workbooks.Open(filename)           ' Открываем нужную книгу ex.Sheets(1).name = "Результаты измерений"     ' Имя первой страницы ex.Sheets(1).Select Set ws = wb.Worksheets(1)                      ' Получаем 1 лист   ws.Cells(1, 1) = "Результаты измерений"        ' Пояснительный текст ws.Cells(2, 1) = "Дата:" ws.Cells(2, 2) = Date                          ' Вставляем системную дату ws.Cells(2, 1) = "Время:" ws.Cells(2, 2) = Time                          ' Вставляем системное время ws.Cells(2, 1) = "График"   For j = 0 To kol_cols                          ' Цикл по количеству столбцов     MSFlexGrid1.Col = j     For i = 0 To kol_rows                      ' Цикл по количеству строк         MSFlexGrid1.Col = i         ws.Cells(i + 5, j + 1) = MSFlexGrid1.Text     Next i Next j     GridGL1.PushToClipBoard                        ' Копируем графическое содержимое компонента GridGL в буфер обмена ws.Paste (Cells(6, 6))                         ' Вставляем из буфера обмена в выбранную ячейку Excel   Set ws = Nothing                               ' Разрываем связь между переменной и объектом wb.Save                                        ' Сохраняем изменения wb.Close                                       ' Закрываем книгу Set wb = Nothing                               ' Разрываем связь между переменной и объектом wbs.Close                                      ' Закрываем коллекцию ex.Quit                                        ' Выходим из Excel'я Set wbs = Nothing                              ' Разрываем связь между переменной и объектом Set ex = Nothing                               ' Разрываем связь между переменной и объектом   Screen.MousePointer = 0                        ' Возвращаем нормальное изображение курсора мыши If err = 0 Then                                ' Если ошибок не было...     res = MsgBox("Данные успешно записаны", vbOKOnly + vbInformation, "Файл создан") End If End Sub