VB vs Excel готовые макросы. Ловите)))
Пользователи, просматривающие топик: none
|
Зашли как: Guest
|
Имя  |
| Сообщение |
<< Старые топики Новые топики >> |
|
|
VB vs Excel готовые макросы. Ловите))) - 2011-02-21 21:46:50.473333
|
|
|
Npc_root
Сообщений: 32
Оценки: -35
Присоединился: 2010-11-02 23:02:41.270000
|
Глава 1. Макросы 8
Запуск макроса с поиском ячейки 8
Запуск макроса при открытии книги 8
Запуск макроса при вводе в ячейку «2» 8
Запуск макроса при нажатии «Ентер» 9
Добавить в панель свою вкладку «Надстройки» (Формат ячейки) 9
Глава 2. Работа с файлами (т.е.обмен данными с ТХТ, RTF, XLS и т.д.) 11
Проверка наличия файла по указанному пути_1 11
Проверка наличия файла по указанному пути_2 11
Проверка наличия файла по указанному пути_3 11
Поиск нужного файла_1 12
Поиск нужного файла_2 12
Поиск нужного файла_3 13
Поиск нужного файла_4 13
Автоматизация удаления файлов 13
Произвольный текст в строке состояния 14
Восстановление строки состояния 14
Бегущая строка в строке состояния 14
Быстрое изменение заголовка окна 14
Быстрое изменение заголовка окна_2 14
Изменение заголовка окна (со скрытием названия файла) 14
Возврат к первоначальному заголовку 15
Что открыто в данный момент 15
Работа с текстовыми файлами 15
Запись и чтение текстового файла 15
Обработка нескольких текстовых файлов 16
Определение конца строки текстового файла 17
Копирование из текстового файла в эксель 18
Копирование содержимого в текстовый файл_1 18
Копирование содержимого в текстовый файл_2 18
Экспорт данных в txt 18
Экспорт данных в HТМL 20
Импорт данных, для которых нужно более 256 столбцов 22
Создание резервных копий ценных файлов 25
Подсчет количества открытий файла 25
Вывод пути к файлу в активную ячейку 26
Копирование содержимого файла RTF в эксель 26
Копирование данных из закрытой книги 27
Извлечение данных из закрытого файла 27
Поиск слова в файлах 28
Создание текстового файла и ввод текста в файл 29
Создание текстового файла и ввод текста (определение конца файла) 30
Создание документов Word на основе таблицы Excel 30
Команды создания и удаления каталогов 32
Получение текущего каталога 32
Смена каталога 32
Посмотреть все файлы в каталоге_1 32
Посмотреть все файлы в каталоге_2 33
Посмотреть все файлы в каталоге_3 35
Глава 3. Рабочая область Microsoft Excel 37
Рабочая книга 37
Количество имен рабочей книги 37
Защита рабочей книги 37
Запрет печати книги 38
Открытие книги (или текстовых файлов) 38
Открытие книги и добавление в ячейку А1 текста 38
Сколько книг открыто 38
Закрытие всех книг 39
Закрытие рабочей книги только при выполнении условия 39
Сохранение рабочей книги с именем, представляющим собой текущую дату 39
Сохранена ли рабочая книга 39
Создать книгу с одним листом 39
Создать книгу 39
Удаление ненужных имен 40
Быстрое размножение рабочей книги 40
Сортировка листов 40
Поиск максимального значения на всех листах книги 42
Рабочий лист 43
Проверка наличия защиты рабочего листа 43
Список отсортированных листов 43
Создать новый лист_1 45
Создать новый лист_2 45
Удаление листов в зависимости от даты 45
Копирование листа в книге 46
Копирование листа в новую книгу (создается) 46
Перемещение листа в книге 46
Перемещение нескольких листов в новую книгу 46
Заменить существующий файл 46
«Перелистывание» книги 46
Вставка колонтитула с именем книги, листа и текущей датой 47
Существует ли лист 47
Существует ли лист_2 47
Вывод количества листов в активной книге 48
Вывод количества листов в активной книге в виде гиперссылок 48
Вывод имен активных листов по очереди 48
Вывод имени и номеров листов текущей книги 48
Сделать лист невидимым 49
Сколько страниц на всех листах? 49
Ячейка и диапазон (столбцы и строки) 49
Копирование строк на другой лист 49
Копирование столбцов на другой лист 49
Подсчет количества ячеек, содержащих указанные значения_1 50
Подсчет количества ячеек в диапазоне, содержащих указанные значения_2 50
Подсчет количества видимых ячеек в диапазоне 51
Определение количества ячеек в диапазоне и суммы их значений 51
Подсчет количества ячеек 51
Автоматический пересчет данных таблицы при изменении ее значений 51
Ввод данных в ячейки 53
Ввод данных с использованием формул 53
Последовательный ввод данных 53
Ввод текстоввых данных в ячейки 53
Вывод в ячейки названия книги, листа и количества листов 54
Удаление пустых строк_1 54
Удаление пустых строк_2 54
Удаление пустых строк_3 55
Удаление строки по условию 55
Удаление скрытых строк 56
Удаление используемых скрытых строк или строк с нулевой высотой 56
Удаление дубликатов по маске 56
Выделение диапазона над текущей ячейкой 57
Выделение диапазона над текущей ячейкой_2 57
Выделить ячейку и поместить туда число 58
Выделение отрицательных значений 58
Выделение диапазона и использование абсолютных адресов 58
Выделение ячеек через интервал_1 59
Выделение ячеек через интервал_2 59
Выделение нескольких диапазонов 60
Движение по ячейкам 60
Поиск ближайшей пустой ячейки столбца 61
Поиск максимального значения 61
Поиск и замена по шаблону 61
Поиск значения с отображением результата в отдельном окне 62
Поиск с выделением найденных данных_1 62
Поиск с выделением найденных данных_2 62
Поиск по условию в диапазоне 63
Поиск последней непустой ячейки диапазона 64
Поиск последней непустой ячейки столбца 64
Поиск последней непустой ячейки строки 64
Поиск ячейки синего цвета в диапазоне 65
Поиск отрицательного значения в диапазоне и выделения синим цветом 65
Поиск наличия значения в столбце 65
Поиск совпадений в диапазоне 66
Поиск ячейки в диапазоне_1 67
Поиск ячейки в диапазоне_2 67
Поиск приближенного значения в диапазоне 67
Поиск начала и окончания диапазона, содержащего данные 68
Поиск начала данных 68
Автоматическая замена значений 68
Быстрое заполнение диапазона (массив) 69
Заполнение через интервал(массив) 69
Заполнение указанного диапазона(массив) 70
Заполнение диапазона(массив) 70
Расчет суммы первых значений диапазона 71
Размещение в ячейке электронных часов 72
«Будильник» 72
Оформление верхней и нижней границ диапазона 72
Адрес активной ячейки 73
Координаты активной ячейки 73
Формула активной ячейки 73
Получение из ячейки формулы 73
Тип данных ячейки 73
Вывод адреса конца диапазона 74
Получение информации о выделенном диапазоне 74
Взять слово с 13 символа в ячейке 76
Создание изменяемого списка (таблица) 77
Проверка на пустое значение 77
Пересечение ячеек 77
Умножение выделенного диапазона на 2 77
Одновременное умножение всех данных диапазона 78
Деление диапазона на 100 78
Возведение каждой ячейки диапазона в квадрат 78
Суммирование данных только видимых ячеек 78
Сумма ячеек с числовыми значениями 79
При суммировании — курсор внутри диапазона 79
Начисление процентов в зависимости от суммы_1 80
Начисление процентов в зависимости от суммы_2 80
Начисление процентов в зависимости от суммы_3 81
Сводный пример расчета комиссионного вознаграждения 81
Движение по диапазону 83
Сдвиг от выделенной ячейки 83
Перебор ячеек вниз по колонне 83
Создание заливки диапазона 84
Подбор параметра ячейки 84
Разбиение диапазона 84
Объединение данных диапазона 85
Объединение данных диапазона_2 85
Узнать максимальную колонку или строку. 86
Ограничение возможных значений диапазона 86
Тестирование скорости чтения и записи диапазонов 88
Открыть MsgBox при выборе ячейки 89
Скрытие строки 89
Скрытие нескольких строк 89
Скрытие столбца 89
Скрытие нескольких столбцов 89
Скрытие строки по имени ячейки 89
Скрытие нескольких строк по адресам ячеек 89
Скрытие столбца по имени ячейки 89
Скрытие нескольких столбцов по адресам ячеек 90
Мигание ячейки 90
Глава 4. Работа с примечаниями 91
Вывод на экран всех примечаний рабочего листа 91
Функция извлечения комментария 91
Список примечаний защищенных листов 91
Перечень примечаний в отдельном списке_1 92
Перечень примечаний в отдельном списке_2 93
Перечень примечаний в отдельном списке_3 93
Подсчет количества примечаний_1 94
Подсчет количества примечаний_2 95
Подсчет примечаний_3 95
Выделение ячеек с примечаниями 95
Отображение всех примечаний 95
Изменение цвета примечаний 96
Добавление примечаний 96
Добавление примечаний в диапазон по условию 96
Перенос комментария в ячейку и обратно 96
Перенос значений из ячейки в комментарий_1 97
Перенос значений из ячейки в комментарий_2 98
Глава . Пользовательские вкладки на ленте 99
Дополнение панели инструментов 99
Добавление кнопки на панель инструментов 99
Панель с одной кнопкой 99
Панель с двумя кнопками 99
Создание панели справа 100
Вызов предварительного просмотра 100
Создание пользовательского меню (вариант 1) 100
Создание пользовательского меню (вариант 2) 101
Создание пользовательского меню (вариант 3) 102
Создание пользовательского меню (вариант 4) 102
Создание пользовательского меню (вариант 5) 102
Создание пользовательского меню (вариант 6) 106
Создание списка пунктов главного меню Excel 108
Создание списка пунктов контекстных меню 108
Отображение панели инструментов при определенном условии 109
Скрытие и отображение панелей инструментов 111
Создать подсказку к моим кнопкам 112
Создание меню на основе данных рабочего листа 112
Создание контекстного меню 115
Блокировка контекстного меню 117
Добавление команды в меню Сервис 118
Добавление команды в меню Вид 119
Создание панели со списком 120
Мультфильм с помощником в главной роли 122
Дополнение помощника текстом, заголовком, кнопкой и значком 123
Новые параметры помощника 124
Использование помощника для выбора цвета заливки 125
Глава . ДИАЛОГОВЫЕ ОКНА 127
Функция INPUTBOX (через ввод значения) 127
Вызов предварительного просмотра 127
Настройка ввода данных в диалоговом окне 127
Открытие диалогового окна (“Открыть файл”)_1 128
Открытие диалогового окна (“Открыть файл”)_2 128
Открытие диалогового окна (“Печать”) 128
Другие диалоговые окна 128
Вызов броузера из Экселя 129
Диалоговое окно ввода данных 129
Диалоговое окно настройки шрифта 129
Значения по умолчанию 129
Глава .Форматирование текста. Таблицы. ГРАНИЦЫ И ЗАЛИВКА. 130
Вывод списка доступных шрифтов 130
Выбор из текста всех чисел 130
Прописная буква только в начале текста 131
Подсчет количества повторов искомого текста 131
Выделение из текста произвольного элемента 132
Отображение текста «задом наперед» 133
Англоязычный текст — заглавными буквами 133
Запуск таблицы символов из Excel 134
глава информация о пользователе, компьютере, принтере и т.д. 136
Получить имя пользователя 136
Вывод разрешения монитора 137
Получение информации об используемом принтере 137
Просмотр информации о дисках компьютера 138
ГЛАВА . ЮЗЕРФОРМЫ 140
Глава . ДИАГРАММЫ 142
Построение диаграммы с помощью макроса 142
Сохранение диаграммы в отдельном файле 143
Построение и удаление диаграммы нажатием одной кнопки 144
Вывод списка диаграмм в отдельном окне 145
Применение случайной цветовой палитры 146
Эффект прозрачности диаграммы 146
Построение диаграммы на основе данных нескольких рабочих листов 148
Создание подписей к данным диаграммы 150
ГлаВА . РАЗНЫЕ ПРОГРАММЫ. 151
Программа для составления кроссвордов 151
Создать обложку DVD 155
Игра «Минное поле» 156
Игра «Угадай животное» 158
Расчет на основании ячеек определенного цвета 161
ГЛАВА .ДРУГИЕ ФУНКЦИИ И МАКРОСЫ 175
Вызов функциональных клавиш 175
Расчет среднего арифметического значения 175
Перевод чисел в «деньги» 175
Поиск ближайшего понедельника 176
Подсчет количества полных лет 177
Расчет средневзвешенного значения 177
Преобразование номера месяца в его название 178
Использование относительных ссылок 178
Преобразование таблицы Excel в HТМL-формат 179
Генератор случайных чисел 181
Случайные числа — на основании диапазона 182
Применение функции без ввода ее в ячейку 183
Подсчет именованных объектов 183
Включение автофильтра с помощью макроса 183
Создание бегущей строки 183
Создание бегущей картинки 184
Вращающиеся автофигуры 185
Вызов таблицы цветов 187
Создание калькулятора 188
Склонение фамилии, имени и отчества 188
ГЛАВА . ДАТА И ВРЕМЯ 194
Вывод даты и времени_1 194
Вывод даты и времени_2 194
Получение системной даты 195
Извлечение даты и часов 195
Функция ДатаПолная 195
ГЛАВА 1. МАКРОСЫ
Запуск макроса с поиском ячейки
' Sub GotoFixedCell:
' Делает активной ячейку, содержащую значение vVariant на
' рабочем листе sSheetName в активной рабочей книге.
'
' Note: Содержимое ячеек интерпретируется как 'значение'!
'
Public Sub GotoFixedCell(vValue As Variant, sSheetName As String)
Dim c As Range, cStart As Range, cForFind As Range
Dim i As Integer
On Error GoTo errhandle:
Set cForFind = Worksheets(sSheetName).Cells ' Диапазон поиска
With cForFind
Set c = .Find(What:=vValue, After:=ActiveCell, LookIn:=xlValues, _
LookAt:= xlРart, SearchOrder:=xlByRows,_
SearchDirection:=xlNext, MatchCase:=False)
Set cStart = c
While Not c Is Nothing
Set c = .FindNext(c)
If c.Address = cStart.Address Then
c.Select
Exit Sub
End If
Wend
End With
Exit Sub
errНandle:
MsgBox Err.Descriрtion, vbExclamation, "Error #" & Err.Number
End Sub
Запуск макроса при открытии книги
Sub Auto_Oрen()
Запуск макроса при вводе в ячейку «2»
Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Object
'On Error Resume Next
If Range("A1").Value = 2 Then
MsgBox "Ох! Значение ячейки стало равным 2-м!"
MsgBox "Я попробую сейчас открыть модуль с процедурой, которая все это делает!"
Application.VBE.MainWindow.SetFocus
Application.VBE.Windows(1).SetFocus
SendKeys "{F7}", True
End If
End Sub
Запуск макроса при нажатии «Ентер»
в модуле листа
Private Sub Worksheet_Selectiоnchange(ByVal Target As Range)
Application.OnKey "{~}", "StartEnter"
End Sub
в модуле книги
Sub StartEnter()
MsgBox ("sadfsdfsf")
End Sub
Добавить в панель свою вкладку «Надстройки» (Формат ячейки)
Код в модуле рабочего листа
Sub Worksheet_Change(ByVal Target As Excel.Range)
Call updаtеToolbar
End Sub
Sub Worksheet_Selectiоnchange(ByVal Target As Excel.Range)
Call updаtеToolbar
End Sub
Листинг 2.43. Код в стандартном модуле
Sub FastChangeNumberFormat()
Dim bar As CommandBar
Dim button As CommandBarButton
' Удаление существующей панели инструментов (если она есть)
On Error Resume Next
CommandBars("Числовой формат").Delete
On Error GoTo 0
' Формирование новой панели
Set bar = CommandBars.Add
With bar
.Name = "Числовой формат"
.Visible = True
End With
' Создание кнопки
Set button = CommandBars("Числовой формат").Controls.Add _
(Type:=msoControlButton)
With button
.Caption = ""
.OnAction = "ChangeNumFormat"
.TooltipText = "Щелкните для изменения числового формата"
.Style = msoButtonCaption
End With
' Обновление созданной панели инструментов
Call updаtеToolbar
End Sub
Sub updаtеToolbar()
' Обновление панели инструментов (если она создана)
On Error Resume Next
' Изменение заголовка кнопки (на название формата выделенной ячейки)
CommandBars("Числовой формат").Controls(1).Caption = _
ActiveCell.NumberFormat
End Sub
Sub ChangeNumFormat()
' Отображение диалогового окна изменения формата ячейки
Application.Dialogs(xlDialogFormatNumber).Show
Call updаtеToolbar
End Sub
ГЛАВА 2. РАБОТА С ФАЙЛАМИ (Т.Е.ОБМЕН ДАННЫМИ С ТХТ, RTF, XLS И Т.Д.)
Проверка наличия файла по указанному пути_1
Sub VerifyFileLocation()
Dim strFileName As String
Dim strFileTitle As String
' Имя и путь искомого файла
strFileTitle = "primer.xls"
strFileName = "C:\Документы\primer.xls"
' Проверка наличия файла (функция Dir возвращает пустую _
строку, если по указанному пути файл обнаружить не удалось)
If Dir(strFileName) <> "" Then
MsgBox "Файл " & strFileTitle & " найден"
Else
MsgBox "Файл " & strFileTitle & " не найден"
End If
End Sub
Проверка наличия файла по указанному пути_2
Sub VerifyFileLocation1()
Dim strFileName As String
' Имя искомого файла
strFileName = "C:\Документы\primer.xls"
' Проверка наличия файла (функция Dir возвращает пустую _
строку, если по указанному пути файл обнаружить не удалось)
If Dir(strFileName) <> "" Then
MsgBox "Файл " & strFileName & " найден"
Else
MsgBox "Файл " & strFileName & " не найден"
End If
End Sub
Проверка наличия файла по указанному пути_3
Sub Check_Disk()
On Error Resume Next
If Dir("\\192.168.1.200\c\", vbSystem) <> "" Then
If Err = 52 Then
Err.Clear
MsgBox "Диска нет!", 48, "Ошибка"
Exit Sub
End If
If Err <> 0 Then
MsgBox "Произошло ошибка!", 48, "Ошибка"
Exit Sub
Else
On Error GoTo 0
MsgBox "Диск есть!", 64, ""
End If
End If
End Sub
Поиск нужного файла_1
Sub FileSearch()
Dim strFileName As String
Dim strFolder As String
Dim strFullPath As String
' Задание имени папки для поиска
strFolder = InputBox("Определите папку:")
If strFolder = "" Then Exit Sub
' Задание имени файла для поиска
strFileName = Application.InputBox("Введите имя файла:")
If strFileName = "" Then Exit Sub
' При необходимости дополняем имя папки "\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
' Полный путь файла
strFullPath = strFolder & strFileName
' Вывод окна с отчетом о поиске средствами VBA
MsgBox "Использование команды VBA..." & vbCrLf & vbCrLf & _
dhSearchVBA(strFullPath), vbInformation, strFullPath
' Вывод окна с отчетом о поиске средствами объекта FileSearch
MsgBox "Использование объекта FileSearch..." & vbCrLf & _
vbCrLf & dhSearchFileSearch(strFolder, strFileName), vbInformation, _
strFullPath
' Вывод окна с отчетом о поиске средствами объекта _
FileSystemObject
MsgBox "Использование объекта FileSystemObject..." & vbCrLf & _
vbCrLf & dhSearchFileSystemObject(strFullPath), vbInformation, _
strFullPath
End Sub
Поиск нужного файла_2
Function dhSearchVBA(varFullPath As Variant) As Boolean
' Использование команды VBA
dhSearchVBA = Dir(varFullPath) <> ""
End Function
Поиск нужного файла_3
Function dhSearchFileSearch(varFolder As Variant, varFileName _
As Variant) As Boolean
' Использование объекта FileSearch
With Application.FileSearch
' Создание нового поиска
.NewSearch
' Имя для поиска
.FileName = varFileName
' Папка поиска
.LookIn = varFolder
' Собственно поиск
.Execute
dhSearchFileSearch = .FoundFiles.Count <> 0
End With
End Function
Поиск нужного файла_4
Function dhSearchFileSystemObject(varFullPath As Variant) As Boolean
Dim objFSObject As Object
' Использование объекта FileSystemObject
Set objFSObject = CreateObject("sсriрting.FileSystemObject")
dhSearchFileSystemObject = objFSObject.FileExists(varFullPath)
End Function
Автоматизация удаления файлов
Листинг 3.51. Удаление файла
Sub DeleteFile()
Kill "C:\Документы\primer.xls"
End Sub
Листинг 3.52. Удаление группы файлов
Sub DeleteFiles()
' Удаление всех файлов с расширением XLS из заданной папки
Kill "C:\Документы" & "*.xls"
End Sub
Произвольный текст в строке состояния
Sub ChangeStatusBarText()
Application.StatusBar = "Как надоело работать!!!"
End Sub
Восстановление строки состояния
Sub ReturnStatusBarText()
Application.StatusBar = False
End Sub
Бегущая строка в строке состояния
Sub MovingTextInStatusBar()
Dim intSpaces As Integer
' Изменение количества пробелов в начале строки (от 20 до 0) - _
строка бежит (скорее, ползет) влево
For intSpaces = 20 To 0 Step -1
' Запись текста в строку состояния
Application.StatusBar = Space(intSpaces) & "Как надоело работать!!!"
' Выдерживаем паузу
Application.Wait Now + TimeValue("00:00:01")
' Дадим Excel обработать пользовательский ввод
DoEvents
Next
Application.StatusBar = False
End Sub
Быстрое изменение заголовка окна
Sub NewTitle()
Application.Caption = "Какая хорошая погода"
End Sub
Быстрое изменение заголовка окна_2
Sub NewTitle()
Application.Caption = "Какая хорошая погода"
ActiveWindow.Caption = "А завтра будет дождь"
End Sub
Изменение заголовка окна (со скрытием названия файла)
Sub NewTitle()
Application.Caption = "Какая хорошая погода"
ActiveWindow.Caption = ""
End Sub
Возврат к первоначальному заголовку
Sub ReturnTitle()
' Возвращение заголовка приложения (то есть Excel)
Application.Caption = Empty
' Указание правильного названия открытого файла (книги)
ActiveWindow.Caption = ThisWorkbook.Name
End Sub
Что открыто в данный момент
Sub WorkBooksList()
Dim book As Object
' Вывод имени каждой рабочей книги
For Each book In Workbooks
MsgBox (book.Name)
Next
End Sub
Работа с текстовыми файлами
Открываются файлы командой Open, а закрываются - командой Close.
Sub Test()
Open "file.txt" For Input As #1
Close #1
End Sub
Запись и чтение текстового файла
Sub Test()
Open "file.txt" For Output As #1
Print #1, "Этот текст будет записан в файл"
Close #1
Open "file.txt" For Input As #1
Dim s As String
Input #1, s
MsgBox s
Close #1
End Sub
Для записи используется оператор Print, а для чтения - Input. У этих операторов есть свои особенности.
Print #1, "Hello , File"
Оператор Input #1 прочитает только Hello и все. Запятая воспринимается как разделитеть. Чтобы прочитать строку целиком, используется оператор Line Input.
Sub Test()
Open "file.txt" For Output As #1
Print #1, "Hello , File"
Close #1
Open "file.txt" For Input As #1
Dim s As String
Line Input #1, s
MsgBox s
Close #1
End Sub
Обработка нескольких текстовых файлов
Sub ImportTextFiles()
Dim fsSearch As FileSearch
Dim strFileName As String
Dim strPath As String
Dim i As Integer
' Задание пути и возможного имени файла
strFileName = ThisWorkbook.path & "\"
strPath = "text??.txt"
' Создание объекта FileSearch
Set fsSearch = Application.FileSearch
' Настройка объекта для поиска
With fsSearch
' Маска для поиска
.LookIn = strFileName
' Путь для поиска
.FileName = strPath
' Поиск всех файлов, удовлетворяющих маске
.Execute
' Выход, если файлы не существуют
If .FoundFiles.Count = 0 Then
MsgBox "Файлы не обнаружены"
Exit Sub
End If
End With
' Обработка найденных файлов
For i = 1 To fsSearch.FoundFiles.Count
Call ImportTextFile(fsSearch.FoundFiles(i))
Next i
End Sub
Sub ImportTextFile(FileName As String)
' Импорт файла
Workbooks.OpenText FileName:=FileName, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlFixedWidth, _
FieldInfo:= _
Array(Array(0, 1), Array(3, 1), Array(12, 1))
' Ввод формул суммирования
Range("D1").Value = "A"
Range("D2").Value = "B"
Range("D3").Value = "C"
Range("E1:E3").Formula = "=COUNTIF(B:B,D1)"
Range("F1:F3").Formula = "=SUMIF(B:B,D1,C:C)"
End Sub
Определение конца строки текстового файла
Sub Test()
Open "file.txt" For Output As #1
Print #1, "Hello , File"
Close #1
Open "file.txt" For Input As #1
Dim s As String
While Not EOF(1)
Input #1, s
MsgBox s
Wend
Close #1
End Sub
Копирование из текстового файла в эксель
Dim TextLine
i = 1
Open "C:\MyFile.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, TextLine
ThisWorkbook.Worksheets("Лист1").Cells(i, 1).Value = TextLine
i = i + 1
Loop
Close #1
Копирование содержимого в текстовый файл_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
Экспорт данных в HТМL
Sub ExportAsHТМLFile()
Dim strStyle As String ' Параметры стиля отображения ячейки
Dim strAlign As String ' Параметры выравнивания ячейки
Dim strOut As String ' Выходная строка с HТМL-кодом
Dim cell As Object ' Обрабатываемая ячейка
Dim strCellText As String ' Текст обрабатываемой ячейки
Dim lngRow As Long ' Номер строки обрабатываемой ячейки
Dim lngLastRow As Long ' Номер строки предыдущей ячейки
Dim strTemp As String
Dim strFileName As String ' Имя файла для сохранения HТМL-кода
Dim i As Long
' Запрос у пользователя имени файла для сохранения
strFileName = Application.GetSaveAsFilename( _
InitialFileName:="Primer.htm", _
fileFilter:="HТМL Files(*.htm), *.htm")
' Проверка, задал ли пользователь имя файла (если нет, _
то можно выходить)
If strFileName = "" Then Exit Sub
lngLastRow = Selection.Row
' Просмотр всех выделенных ячеек
For Each cell In Selection
' Значение строки для рассматриваемой ячейки
lngRow = cell.Row
' Если перешли на другую строку, то вставляем <tr>
If lngRow <> lngLastRow Then
strOut = strOut & vbTab & "</tr>" & vbCrLf & vbTab & _
"<tr>" & vbCrLf
' Переход на следующую сроку
lngLastRow = lngRow
End If
' Задание шрифта ячейки
If Not IsNull(cell.Font.Size) Then
strStyle = " style=" & "font-size: " & Int(100 * _
cell.Font.Size / 19) & "%;"
End If
' Для полужирного шрифта вставляем <b>
If cell.Font.Bold Then
strCellText = "<b>" & strCellText & "</b>"
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 = ""
' Печать после каждого символа специального _
разделителя - <br>
For i = 1 To Len(strCellText)
strTemp = strTemp & Mid$(strCellText, i, 1) & "<br>"
Next i
strCellText = strTemp
strStyle = ""
End If
strOut = strOut & vbTab & vbTab & "<td" & strStyle & _
strAlign & ">" & strCellText & "</td>" & vbCrLf
Next
' Вставка <tr> для первой строки и </tr> - для последней
strOut = vbTab & "<tr>" & vbCrLf & strOut & vbTab & "</tr>" & vbCrLf
' Вставка дескриптора <table>
strOut = "<table border=1 cellpadding=3 cellspacing=1>" _
& vbCrLf & strOut & vbCrLf & "</table>"
' Сохранение HТМL-кода в файл
Open strFileName For Output As 1
Print #1, strOut
Close 1
' Вывод окна с информационным сообщением о результатах работы
MsgBox Selection.Count & " ячеек экспортировано в файл " & _
strFileName
End Sub
Импорт данных, для которых нужно более 256 столбцов
Sub ImportWideSheet()
Dim rgRange As Range ' Хранит заполняемую ячейку
Dim lngRow As Long ' Хранит номер текущей строки
Dim intCol As Integer ' Хранит номер текущего столбца
Dim i As Integer
Dim strLine As String ' Обрабатываемая строка (из файла)
Dim strCurChar As String * 1
Dim strCellValue As String ' В этой строке формируется значение _
заполняемой ячейки таблицы
Dim wshtCurrentSheet As Worksheet ' Лист, на котором находится _
заполняемая ячейка
' Отключение обновления изображения
Application.ScreenUpdating = False
' Создание книги с одним листом
Workbooks.Add xlWorksheet
Set rgRange = ActiveWorkbook.Sheets(1).Range("A1")
' Чтение первой строки из файла (по этой строке определяется _
ширина таблицы)
Open ThisWorkbook.Path & "\Primer.txt" For Input As #1
Line Input #1, strLine
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-21 21:47:51.400000
|
|
|
Npc_root
Сообщений: 32
Оценки: -35
Присоединился: 2010-11-02 23:02:41.270000
|
думаю поможет вам решить многие вопросы)
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-21 21:51:10.366666
|
|
|
Npc_root
Сообщений: 32
Оценки: -35
Присоединился: 2010-11-02 23:02:41.270000
|
советую скопировать в ворд и сохранить)))
если надо кому - сброшу файл в почту.
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-21 22:21:04.250000
|
|
|
Onsa
Сообщений: 5
Оценки: 0
Присоединился: 2011-02-10 00:28:20.560000
|
В рот мне ноги, сохраню ка себе.
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-21 22:32:26.190000
|
|
|
Alianna
Сообщений: 1922
Оценки: 356
Присоединился: 2010-03-02 11:27:12.343333
|
ТС, огромная просьба оформить первый пост в теги code
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-21 23:54:36.536666
|
|
|
Sрam
Сообщений: 2863
Оценки: 372
Присоединился: 2009-01-16 15:23:43.276666
|
А как-бэ вопрос: это что?8|
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-22 21:29:40.090000
|
|
|
Npc_root
Сообщений: 32
Оценки: -35
Присоединился: 2010-11-02 23:02:41.270000
|
quote:
ORIGINAL: Alianna
ТС, огромная просьба оформить первый пост в теги code
сделано.
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-02-22 21:33:51.083333
|
|
|
Npc_root
Сообщений: 32
Оценки: -35
Присоединился: 2010-11-02 23:02:41.270000
|
quote:
ORIGINAL: Sрam
А как-бэ вопрос: это что?8|
как бе код.
думаю многим пригодится в работе.
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-07-30 01:43:27.330000
|
|
|
IgorLuPro
Сообщений: 4
Оценки: 0
Присоединился: 2011-02-04 22:47:56.380000
|
Очень нужно - думаю что то пригодится, спасибо!
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-08-08 07:07:46.690000
|
|
|
nbkbnbkbgfv
Сообщений: 1
Оценки: 0
Присоединился: 2011-08-08 06:56:01.750000
|
Специально зарегался чтоб сказать спасибо)
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-08-08 11:06:45.510000
|
|
|
TremaS
Сообщений: 18
Оценки: 0
Присоединился: 2011-07-27 14:07:14.233333
|
Круто! Спс!!
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-09-18 11:32:19.520000
|
|
|
adventurerodnako
Сообщений: 1
Оценки: 0
Присоединился: 2011-09-18 11:21:58.376666
|
Большое спасибо. Сохранил, буду пользоваться. 8|
|
|
|
|
|
RE: VB vs Excel готовые макросы. Ловите))) - 2011-11-16 10:13:53.943333
|
|
|
Mirron
Сообщений: 2
Оценки: 0
Присоединился: 2011-08-01 16:22:55.176666
|
Нужна помощь!
Вопрос, специалистам и не только :). Имеется папка с файлами xls. с одинаковой структурой, которые ежедневно добавляются. Можно ли написать макрос который автоматически при открытии книги делал проверку на появлении новых файлов и при обнаружения таковых подхватывал сохраняя и объединяя в один лист книги.
Заранее спасибо!
Очень выручите!!!!!!!!!!!
|
|
|
|
|
|
