Главная страница
Навигация по странице:

  • If cell.Font.Bold ThenstrCellText = "" strCellText "

  • Готовые макросы в VBA Excel (Миронов.) (z-lib.org). Запуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6


    Скачать 1.47 Mb.
    НазваниеЗапуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6
    Дата26.06.2022
    Размер1.47 Mb.
    Формат файлаdoc
    Имя файлаГотовые макросы в VBA Excel (Миронов.) (z-lib.org).doc
    ТипДокументы
    #615298
    страница5 из 47


    If lngRow <> lngLastRow Then

    strOut = strOut & vbTab & "" & vbCrLf & vbTab & _

    "" & vbCrLf

    ' Переход на следующую сроку

    lngLastRow = lngRow

    End If

    ' Задание шрифта ячейки

    If Not IsNull(cell.Font.Size) Then

    strStyle = " font-size: " & Int(100 * _

    cell.Font.Size / 19) & "%;"

    End If

    ' Для полужирного шрифта вставляем

    If cell.Font.Bold Then

    strCellText = "" & strCellText & ""

    End If

    ' Задание выравнивания

    If cell.HorizontalAlignment = xlRight Then

    ' По правому краю

    strAlign = " align=" & "right"

    ElseIf cell.HorizontalAlignment = xlCenter Then

    ' По центру

    strAlign = " align=" & "center"

    Else

    ' По левому краю (по умолчанию)

    strAlign = ""

    End If

    ' Чтение текста в ячейке

    strCellText = cell.Text

    ' Если нужно, то вертикальный вывод текста (в строку strTemp _

    с последующим перенесением обратно в strCellText)

    If cell.Orientation <> xlHorizontal Then

    strTemp = ""

    ' Печать после каждого символа специального _

    разделителя -


    For i = 1 To Len(strCellText)

    strTemp = strTemp & Mid$(strCellText, i, 1) & "
    "

    Next i

    strCellText = strTemp

    strStyle = ""

    End If

    strOut = strOut & vbTab & vbTab & "
    strAlign & ">" & strCellText & "" & vbCrLf

    Next

    ' Вставка
    для первой строки и - для последней

    strOut = vbTab & "
    " & vbCrLf & strOut & vbTab & "" & vbCrLf

    ' Вставка дескриптора
    1   2   3   4   5   6   7   8   9   ...   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

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


    strOut = "
    " _

    & vbCrLf & strOut & vbCrLf & "
    "

    ' Сохранение HTML-кода в файл

    Open strFileName For Output As 1

    Print #1, strOut

    Close 1

    ' Вывод окна с информационным сообщением о результатах работы

    MsgBox Selection.Count & " ячеек экспортировано в файл " & _

    strFileName

    End Sub
    1   2   3   4   5   6   7   8   9   ...   47


    написать администратору сайта