Готовые макросы в vba excel, Миронов Глава Макросы 9
Скачать 1.35 Mb.
|
Копирование содержимого в текстовый файл_1Sub Range2TXT() MyFile = "C:\File.txt" 'путь к файлу Open MyFile For Output As #1 'открыли для записи For Each i In Selection 'листаем ячейки выделенного диапазона Print #1, i 'пишем (с начала) Next Close #1 'закрываем End Sub Копирование содержимого в текстовый файл_2Sub SaveAsText() Dim cell As Range ' Открытие файла для сохранения (имя файла соответствует имени _ рабочей книги, но отличается расширением - TXT) Open ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".txt" _ For Output As #1 ' Запись содержимого заполненных ячеек таблицы в файл For Each cell In ActiveSheet.UsedRange If Not IsEmpty(cell) Then Print #1, cell.Address, cell.Formula End If Next ' Не забываем закрывать файл Close #1 End Sub Экспорт данных в txtSub ExportAsText() Dim lngRow As Long Dim intCol As Integer ' Открытие файла для сохранения Open "C:\primer.txt" For Output As #1 ' Запись выделенной части таблицы в файл (построчно) For lngRow = 1 To Selection.Rows.Count ' Запись содержимого всех столбцов строки lngRow For intCol = 1 To Selection.Columns.Count Write #1, Selection.Cells(lngRow, intCol).Value; Next intCol ' Начнем новую строку в файле Print #1, "" Next lngRow ' Не забываем закрыть файл Close #1 End Sub Sub ImportText() Dim strLine As String ' Одна строка файла Dim strCurChar As String * 1 ' Анализируемый символ строки файла Dim strValue As String ' Значение для записи в ячейку Dim lngRow As Long ' Номер текущей строки Dim intCol As Integer ' Номер текущего столбца Dim i As Integer ' Открытие импортируемого файла Open "C:\primer.txt" For Input As #1 ' Считываем все строки файла и записываем данные, разделенные _ запятой, в ячейки таблицы (начиная с текущей ячейки) Do Until EOF(1) ' Считываем строку из файла Line Input #1, strLine ' Разбираем считанную строку For i = 1 To Len(strLine) strCurChar = Mid(strLine, i, 1) If strCurChar = "," Then ' Найден разделитель столбцов - запятая. Запишем _ сформированное значение в ячейку ActiveCell.Offset(lngRow, intCol) = strValue intCol = intCol + 1 strValue = "" ElseIf i = Len(strLine) Then ' Конец строки - запишем в таблицу последнее _ значение в строке (перед этим дополним его последним _ символом строки, кроме кавычки) If strCurChar <> Chr(34) Then strValue = strValue & strCurChar End If ' Запись в таблицу ActiveCell.Offset(lngRow, intCol) = strValue strValue = "" ElseIf strCurChar <> Chr(34) Then ' Добавление символа в формируемое значение ячейки _ (кавычки игнорируются) strValue = strValue & strCurChar End If Next i ' Переход к новой строке таблицы intCol = 0 lngRow = lngRow + 1 Loop ' Закрываем файл Close #1 End Sub Экспорт данных в htmlSub ExportAsHtmlFile() Dim strStyle As String ' Параметры стиля отображения ячейки Dim strAlign As String ' Параметры выравнивания ячейки Dim strOut As String ' Выходная строка с HTML-кодом Dim cell As Object ' Обрабатываемая ячейка Dim strCellText As String ' Текст обрабатываемой ячейки Dim lngRow As Long ' Номер строки обрабатываемой ячейки Dim lngLastRow As Long ' Номер строки предыдущей ячейки Dim strTemp As String Dim strFileName As String ' Имя файла для сохранения HTML-кода Dim i As Long ' Запрос у пользователя имени файла для сохранения strFileName = Application.GetSaveAsFilename( _ InitialFileName:="Primer.htm", _ fileFilter:="HTML Files(*.htm), *.htm") ' Проверка, задал ли пользователь имя файла (если нет, _ то можно выходить) If strFileName = "" Then Exit Sub lngLastRow = Selection.Row ' Просмотр всех выделенных ячеек For Each cell In Selection ' Значение строки для рассматриваемой ячейки lngRow = cell.Row ' Если перешли на другую строку, то вставляем | |
' Сохранение HTML-кода в файл
Open strFileName For Output As 1
Print #1, strOut
Close 1
' Вывод окна с информационным сообщением о результатах работы
MsgBox Selection.Count & " ячеек экспортировано в файл " & _
strFileName
End Sub