Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 23.01.2019
• Размер: 1.35 Mb.
• Имя файла: Готовые макросы в VBA Excel, Миронов.doc
• Тип: Документы; #64865
• страница: 5 из 47

Копирование содержимого в текстовый файл_1

Sub Range2TXT()

MyFile = "C:\File.txt" 'путь к файлу

Open MyFile For Output As #1 'открыли для записи

For Each i In Selection 'листаем ячейки выделенного диапазона

Print #1, i 'пишем (с начала)

Next

Close #1 'закрываем

End Sub

Копирование содержимого в текстовый файл_2

Sub 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

Экспорт данных в txt

Sub 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

Экспорт данных в html

Sub 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

' Если перешли на другую строку, то вставляем