Хранилище полезных ресурсов

Автоматическая вставка картинок (изображений) на лист Excel

koralek — Wed, 15 Apr 2020 15:54:22 GMT

Вставка картинок (изображений) на лист Excel

Надстройка позволяет искать в выбранной папке изображения, основываясь на содержимом ячеек таблицы Excel, и производить вставку найденных изображений в соседние ячейки (или в примечания к этим ячейкам).

Особенности надстройки:
поиск картинок в подпапках (глубина поиска по подпапкам не ограничена)
установка выбранного пользователем размера для вставляемых изображений
отображение состояния поиска и вставки изображений (прогресс-бар)
вывод результатов обработки таблицы (сколько изображений вставлено, сколько не найдено)
добавление гиперссылок к вставляемым изображениям (по щелчку на картинке открывается исходный файл)
2 режима поиска файлов - по точному совпадению имени файла, и по началу имени файла-изображения
2 режима вставки картинок - подгонка размеров под ячейку, или соблюдение пропорций исходного изображения
вывод количества файлов в выбранной папке
возможность выбора столбца с названиями файлов, и указания номера столбца для вставляемых изображений
возможность вставки изображений в комментарии к ячейкам

Принцип работы с макросом:
Скачиваем прикреплённый архив, и извлекаем из него папку InsertPicsEx куда-нибудь себе на диск.
Открываем файл (надстройку) программа.xla (запустится пустой Excel - файл надстройки не отображается)
Открываем файл с названиями картинок - например, присутствующий в папке файл для обработки.xls
Нажимаем Ctrl + Shift + K для запуска формы надстройки
В появившейся форме выбираем путь к папке, содержащей картинки (изображения)
Выставляем необходимые размеры для ячеек с картинками, выбираем первую ячейку на листе с именем файла
Указываем номер столбца, в который будут помещены изображения
Нажимаем зелёную кнопку, и через несколько секунд получаем результат.

Скачать (размер 456Кб)

Excel-макрос, данные которого также отображаются в html

vladas1983 — Mon, 14 Dec 2015 08:00:45 GMT

Есть html-поздравление и оно именное. Для удобства обычных пользователей нужно я придумал сделать excel-файл со списком имен и фамилий в виде строк (на одной строке в одной ячейке одно Имя и Фамилие. Эти данные должны отображаться в html-поздравлении, возможно через php-код или еще какой-то скрипт. Обычный пользователь создает копию html-файла, в названии которого будет номер строки excel для того, чтобы было понятно, с какой строки брать данные. (Например, 2_ivanov.html). Смысл такой, чтобы обычный пользователь без знаний html мог удобно и просто создать нового html-файл с новым клиентом. Если, возможно, то лучше этот макрос мог бы создать html-файл с поздравлением на основе html-шаблона. Будет, например, еще один столбец рядом с указанием имени html-файла или название файла генерироваться автоматически ("Номер строки"_"имя_фамилия (на латинице)", например, 1_ivan_ivanovich.html). Номер строки нужен, т.к. Иван Ивановичей может быть много и второй файл пересохранит первый. Эти данные должны редактироваться и удаляться.
Возможно, есть какой-то другой простой способ? Необязательно через excel-макрос, а через txt-файл, где данные также будут построчно вводится.

VBA Excel полезные строки кода

koralek — Fri, 10 Apr 2015 13:45:16 GMT

Определение строки где есть слово "Колличество"
dd = Sheets(i).Cells.Find(What:="Колличество").Row

Определение колонки где есть слово "Колличество"
ddd = Sheets(i).Cells.Find(What:="Колличество").Column

Добавлено (21.03.2015, 17:50)
---------------------------------------------
Буфер обмена
ClipboardText (чтение текста из буфера обмена), но не требующая подключения библиотеки

Sub ПримерИспользования()

txt = ClipboardText

MsgBox txt, vbInformation, "Содержимое буфера обмена Windows"

End Sub

Function ClipboardText() ' чтение из буфера обмена

With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

.GetFromClipboard

ClipboardText = .GetText

End With

End Function

Sub SetClipboardText(ByVal txt$) ' запись в буфер обмена

With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

.SetText txt$

.PutInClipboard

End With

End Sub

Добавлено (21.03.2015, 17:53)
---------------------------------------------
Как определить адрес активной ячейки.
ActiveCell.Row и ActiveCell.Column - покажут координаты активной ячейки

Добавлено (10.04.2015, 15:43)
---------------------------------------------
Определение последней заполненной строки
lLastRow = Cells.SpecialCells(xlLastCell).Row

Определение последнего столбца
lLastCol = Cells.SpecialCells(xlLastCell).Column

Данный метод не требует указания номера столбца и возвращает максимальную последнюю ячейку(строку - Row либо столбец - Column). Но используя данный метод следует помнить, что не всегда можно получить
реальную последнюю заполненную ячейку, т.е. именно ячейку со значением.
Если вы где-то ниже занесете данные и сразу удалите их из таблицы, а
затем примените такой метод, то lLastRow будет равна значению строки, из которой вы только что удалили значения. Другими
словами требует обязательного обновления данных, а этого можно добиться
только сохранив и закрыв документ и открыв его снова. Так же, если
какая-либо ячейка содержит форматирование(например, заливку), но не содержит никаких значений, то она тоже будет считаться заполненной.Я этот метод использую только для определения в только что созданном документе, в котором только добавляю строки.

Добавлено (10.04.2015, 16:18)
---------------------------------------------
Получение ссылки ячейки в буквенном формате

a = Cells(1, 1).Address ' результат "$A$1"

Добавлено (10.04.2015, 16:45)
---------------------------------------------
' Вгоняем в массив все данные листа

            Set Sheet1_WS = Sheets("исх дан")
            FinalRow = maxzapolnstr
            FinalColumn = 20
            'Присваиваем массиву диапазон данных на Листе 1
            R_data = Sheet1_WS.Range(Sheet1_WS.Cells(1, 1), Sheet1_WS.Cells(FinalRow, FinalColumn))

Как вернуть внешний вид окна проекта VBA Excel

koralek — Thu, 02 Apr 2015 12:41:27 GMT

Форум: Excel Макросы (VBA)
Автор темы: koralek
Автор последнего сообщения: koralek
Количество ответов: 0

Excel комментарии изменить размеры и размещение

koralek — Fri, 27 Feb 2015 13:31:36 GMT

Dim c As Range
    For Each c In ActiveWorkbook.Worksheets("All").Range("A1:kU300")
        If Not (c.Comment Is Nothing) Then ' у ячейки есть примечание
           ' c.Comment.Shape.Width = 84.75 ' ширина комментария
           ' c.Comment.Shape.Height = 57#   ' высота комментария

            c.Comment.Shape.Top = c.Top + 10
            c.Comment.Shape.Left = c.Offset(, 1).Left + 20
        End If
    Next c

Оптимизация VBA

koralek — Fri, 09 Jan 2015 12:55:39 GMT

На этой странице перечислены некоторые советы и стратегии по оптимизации Visual Basic For Applications (VBA) кода. Есть несколько абсолютных правил для оптимизации VBA, вы увидите увеличение производительности за счет оптимизации базовой логики.

Доступ ячеек в диапазоне

Вам не нужно использовать. Клетки метод для доступа к определенным ячеек в диапазоне. Например, вы можете использовать

Range("MyRange")(1,2) а не
Range("MyRange").Cells(1,2)

Смотрите Алан Beban в объяснение этого метода для более подробной информации.
С этим связана ускоренный метод ссылкой на клетки. VBA позволит вам ссылаться на ячейки с [A1], а не Range ("A1"). В то время как [A1] синтаксис легче ввести, это медленнее, чем выполнить Range ("A1") синтаксис.

Расчет режима

Как правило, Excel пересчитает ячейки или диапазона ячеек при том, что ячейки или диапазона на прецеденты были изменены. Это может привести к книге пересчитать слишком часто, что приведет к замедлению работы. Вы можете предотвратить Excel от переоценки книгу с помощью заявлением:

Application.Calculation = xlCalculationManual
В конце вашего кода, вы можете установить режим расчета обратно в автоматический с заявлением:

Application.Calculation = xlCalculationAutomatic
Помните, однако, что при расчете режима xlCalculationManual, Excel не обновляются значения в ячейках. Если ваш макрос основывается на обновлении ячейки значение, вы должны заставить события Calculate, с. Рассчитайте метод, который может быть применен либо определенного диапазона (Range ("Мой_диапазон"). Вычислить) или всей книги (Вычислить) .

Коллекция индексы

Отдельного элемента из коллекции объект может быть доступна либо его имя или его индекс в коллекции. Например, если у вас есть три листа ("Лист1", "Лист2" и "Sheet3") в книге ("MyWorkbook»), вы можете ссылаться на "Лист2" или с

Worksheets("Sheet2") or
Worksheets(2)

В общем, метод индексов (Worksheets(2)) значительно быстрее, чем метод имя индекса (Worksheets ("Лист2")).
Тем не менее, количество и порядок элементов в коллекции может меняться, поэтому, как правило, безопаснее и проще ссылаться на элементы в коллекции по имени, а не их порядковый номер.[b]

Как разобрать HTML файл из VBA кода в Excel?

koralek — Fri, 22 Mar 2013 12:51:28 GMT

- Открыть HTML файл из VBA код (с с)
- Доступ теги, которые имеют определенный атрибут (а именно: класс = "Шрифт" ширина = "220")
- Скопировать значение этих ячеек таблицы в Excel клетки

Если при выполнении кода сообщение об ошибке: "User-defined type not defined", то In Tools - References in the VB Editor, tick MS Internet Controls, or Dim appIE As Object. Your code declares MSHTML objects so you also need the MS HTML Object Library reference.

Sub Extract_TD_text()

Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim TDelements As IHTMLElementCollection
Dim TDelement As HTMLTableCell
Dim r As Long

'Saved from www vbaexpress com/forum/forumdisplay.php?f=17
URL = "http://www.vbaexpress.com/forum/forumdisplay.php?f=17"

Set IE = New InternetExplorer

With IE
.navigate URL
.Visible = True

'Wait for page to load
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend

Set HTMLdoc = .document
End With

Set TDelements = HTMLdoc.getElementsByTagName("TD")

Ëèñò1.Cells.ClearContents

r = 1
For Each TDelement In TDelements
'Look for required TD elements - this check is specific to VBA Express forum - modify as required
If TDelement.className = "alt2" And TDelement.Align = "center" Then
Cells(r, 1).Value = TDelement.innerText
r = r + 1
End If
Next

End Sub

Скачивание (загрузка) текста web-страницы в текстовый файл

koralek — Sat, 23 Feb 2013 14:53:13 GMT

При помощи этого макроса вы можете скачать текст с выбранной страницы веб-сайта:

Sub ЗагрузкаТекстаВебСтраницы()
Set IE = CreateObject("InternetExplorer.Application"): ' загружаем браузер Internet Explorer
On Error Resume Next
addr$ = "http://excelvba.ru/services" ' указываем адрес сайта (веб-страницы), текст которой загружаем

IE.Navigate addr$ ' загружаем сайт
While IE.busy Or (IE.readyState <> 4): DoEvents: Wend ' ждем, пока загрузится страница
' Set ieDoc = IE.Document ' ссылка на открытый документ

txt$ = IE.Document.body.innerText ' считываем текст веб-страницы в текстовую переменную

'[a1] = txt$ ' помещаем текст веб-страницы на лист Excel
IE.Quit: Set IE = Nothing ' закрываем браузер

MsgBox txt$, vbInformation, "Текст веб-страницы " & addr$ ' выводим сообщение с текстом с сайта
End Sub

То же самое - но в виде функции:

Function WebPageText(ByVal sURL As String) As String
On Error Resume Next
Set IE = CreateObject("InternetExplorer.Application"): ' загружаем браузер Internet Explorer
IE.Navigate sURL ' загружаем сайт
While IE.busy Or (IE.readyState <> 4): DoEvents: Wend ' ждем, пока загрузится страница
WebPageText = IE.Document.body.innerText ' считываем текст веб-страницы
IE.Quit: Set IE = Nothing ' закрываем браузер
End Function

Пример использования этой функции для загрузки текста страниц из интернета:
Sub ПримерИспользованияФункции_WebPageText()
' считываем текст страницы http://excelvba.ru/services в переменную txt
txt = WebPageText("http://excelvba.ru/services")
' получаем путь к папке "Рабочий стол"
ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' сохраняем текст из переменной txt в файл PageText.txt на рабочем столе
SaveTXTfile ПутьКРабочемуСтолу & "\PageText.txt", txt
' открываем созданный текстовый файл в Excel
Workbooks.OpenText ПутьКРабочемуСтолу & "\PageText.txt", , , xlDelimited
End Sub

Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
On Error Resume Next: Err.Clear
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.CreateTextFile(filename, True)
ts.Write txt: ts.Close
SaveTXTfile = Err = 0
Set ts = Nothing: Set fso = Nothing
End Function

Скачивание исходного кода web-страницы в текстовый файл

koralek — Sat, 23 Feb 2013 14:47:53 GMT

Данная функция возвращает исходный текст web-страницы:

Function GetHTTPResponse(ByVal sURL As String) As String
On Error Resume Next
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
With oXMLHTTP
.Open "GET", sURL, False
' раскомментируйте следующие строки и подставьте верные IP, логин и пароль
' если вы сидите за proxy
' .setProxy 2, "192.168.100.1:3128"
' .setProxyCredentials "user", "password"
.send
GetHTTPResponse = .responseText
End With
Set oXMLHTTP = Nothing
End Function

Пример использования функции GetHTTPResponse

Private Sub ПримерИспользованияФункции_GetHTTPResponse()
' считываем исходный текст страницы ExcelVBA.ru в переменную txt
txt = GetHTTPResponse("http://ExcelVBA.ru")
' получаем путь к папке "Рабочий стол"
ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' сохраняем текст из переменной txt в файл PageText.txt на рабочем столе
SaveTXTfile ПутьКРабочемуСтолу & "\PageText.txt", txt
' открываем созданный текстовый файл в Excel
Workbooks.OpenText ПутьКРабочемуСтолу & "\PageText.txt"
End Sub

Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
On Error Resume Next: Err.Clear
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.CreateTextFile(filename, True)
ts.Write txt: ts.Close
SaveTXTfile = Err = 0
Set ts = Nothing: Set fso = Nothing
End Function

Полная автоматизация получения данных веб-страницы в листе E

koralek — Wed, 20 Feb 2013 15:13:13 GMT

Полная автоматизация получения данных веб-страницы в листе Excel с помощью VBA

В этом видео мы показываем полную автоматизацию как получить данные в лист Excel с помощью VBA.1. Мы сначала изучить сайт и узнать элементов мы должны будем получить доступ к форме и последующие результаты. Когда вы будете изучать исходный код веб-страницы вы заметите, что фактические результаты, завернутый в DIV контейнеров.2. Далее мы написать код VBA Мы используем GetElementById метод, чтобы получить ссылку на один объект и GetElementsByTagName метод, чтобы получить коллекцию всех элементов. Далее мы проходим по всем элементам и получить свойства текста или данных ('InnerText') всех элементов, которые мы хотели бы иметь. Наш код создает экземпляр нашего веб-браузера (Internet Explorer) и переходит на адрес нашего выбора, а затем помогает получить или извлечь данные с помощью событий. Мы также гарантируем, что код помещены в соответствующие строки и столбцы так, что любой дальнейший анализ производится легко. Наконец, мы используем записанный макрос для форматирования данных, чтобы сделать его более презентабельным для человеческого глаза. Примечание: Если имена классов или другие изменения в код HTML на веб-странице вам нужно изменить ваш код VBA соответственно, чтобы очистить данные правильно.Макро-код, чтобы получить данные веб-страницы в листе Excel с помощью VBA приведен ниже:

Sub test()
Dim eRow As Long
Dim ele As Object
Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Title"
sht.Range("B" & RowCount) = "Company"
sht.Range("C" & RowCount) = "Location"
sht.Range("D" & RowCount) = "Description"
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objIE = CreateObject("InternetExplorer.Application")
myjobtype = InputBox("Enter type of job eg. sales, administration")
myzip = InputBox("Enter zipcode of area where you wish to work")
With objIE
.Visible = True
.navigate "http://www.jobs.com/"
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set what = .document.getElementsByName("q")
what.Item(0).Value = myjobtype
Set zipcode = .document.getElementsByName("where")
zipcode.Item(0).Value = myzip
.document.getElementById("JobsButton").Click
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
For Each ele In .document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "Title"
sht.Range("A" & RowCount) = ele.innertext
Case "Company"
sht.Range("B" & RowCount) = ele.innertext
Case "Location"
sht.Range("C" & RowCount) = ele.innertext
Case "Description"
sht.Range("D" & RowCount) = ele.innertext
End Select
Next ele
End With
Macro1
Set objIE = Nothing
End Sub
Sub Macro1()
'
' Macro1 Macro
' Formatting imported data
'
'
Columns("A:D").Select
Selection.Columns.AutoFit
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("D1").Select
Columns("D:D").ColumnWidth = 50
Columns("A:D").Select
Selection.Rows.AutoFit
End Sub

Watch the training video below to see how the process of complete automation of data collection from a web page into an Excel spreadsheet is implemented:

http://www.familycomputerclub.com/get-web....ba.html