» Excel VBA (часть 3)

gangsterA
Смотри пример: http://rghost.ru/38232669

Спасибо, psiho!

Про вариант с DoEvents я знал. Но мне хотелось бы сделать, не что другое.... Напримеро к объекту application подсоединить какой нибудь отловщик событий завершения процесса. Допустим когда мы на кнопку нажимаем, у нас же в VBA никакой ожидающий код, который понимает, что кнопка была нажата, "не крутиться". Или я ошибаюсь и все обмены между процессами устроенны таким образом?


Код:
Do
//Проверяем завершился ли процесс
//Обрабатываем сообщения
Loop Until ReturnValue <> 258

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

Большое спасибо, psiho!

Думаю, пока остановиться на варианте с DoEvents.

Но все же очень интересен Ваш второй метод.

Цитата:

Для того, чтобы реализовать Вашу затею, необходимо подключать в Excel такой же таймер, как в Visual Basic, и в его обработчике отлавливать окончание процесса.

Собсвенно не очень понял, как к Excel подключить "такой же таймер, как в Visual Basic".
Т.е. после этого измениться сам Excell, и программу нельзя будет запустить на другом компьютере, где Excell не изменён?

Можете описать как Вы это делали, хотя бы в общих чертах?

gangsterA
Ни в коем случае Excel не меняется, просто в коде книги вставляется процедура запуска таймера. Этот таймер срабатывает каждые 0,5 секунды. После окончания этого интервала каждый раз проверяется выполнение любого заданного Вами условия и выполняется Ваш код. Правда, здесь всё равно без "DoEvents" не обойтись.

А формы для вставки таймера создавать не нужно?

И что тут рискованного? Вешаем обычный таймер, это же стандартное средсвто? И не очень понятно зачем здесь понадобиться "DoEvents"? Вроде бы в таймере просто ждем небольшое окончание процесса с WaitForSingleObject, там ставим время ожидания 1мс. И зачем туда пихать DoEvents, разве что только долгий код выполняться будет?

А таймер запускаем достаточно редко допустим через каджые 30сек. Когда процесс останновился выставляем в таймере enabled = false. И ожидание останавливаеться. В приципе все более менее красиво.
Думаю общение в ОС между процессами устроенно приблизительно так же, хотя и не уверен.

А в обще, в целом очень хорошая идея.

Цитата:

А таймер запускаем достаточно редко допустим через каджые 30сек

Вот в этом-то и загвоздка. Excel и должен отслеживать постоянно эти 30 сек. А это можно сделать только через "DoEvents"

gangsterA

VBA Shell and Wait with Exit Code(WaitForSingleObject)
Spy on a Folder to Detect When it Change
Wait for a Process to Terminate w/ WaitForSingleObject
excel waitforsingleobject

Цитата:

Вот в этом-то и загвоздка. Excel и должен отслеживать постоянно эти 30 сек. А это можно сделать только через "DoEvents"

Эмм не очень, то понял... Ладно попробую написать чего нить, потом отпишуся что получилось

Добавлено:
Мдя... Столкнулся с очень интересной проблемой? а как добавить таймер в excell?
Ожидал проблем от многого, но чтоб от этого...

Добавлено:
Нашел что-то типа Application.OnTime
Ладно завтра буду разбираться

gangsterA
Таймер включаешь сразу же при открытии книги в процедуре Workbook_Open

Добрый день!

Снова прошу оказать посильную помощь в изменении макроса.

Посредством макроса осуществляется отправка копии страницы из книги excel.
Макрос взят на просторах интернета и доработан при помощи участника форума psiho. Сам макрос и ссылка на файл из которого происходит отправка сообщения ниже.

Можно ли макрос отправки сообщения изменить так, чтоб при отправке сообщения к имени файла добавлялось название месяца (определить отчётный месяц можно по столбцу A в файле из которого происходит отправка, формат даты: 01.03.12 00:00:24) т.е. макрос просматривает даты в столбце A, и определяет по 4 и 5 знакам отчётный месяц (01 - январь, 02 - февраль, и.т.д) и соответственно при отправке добавляет к имени файла название отчетного месяца?

Файл можно скачать тут: http://files.mail.ru/CM0SEX


Макрос:

Код:
Sub ОТПРАВЛЯЕМ_ВХОДЯЩИЙ()
Dim OutApp As Object, wbTemp As Workbook
Dim OutMail As Object
Dim cell As Range

ActiveWorkbook.Save
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
Set wbTemp = Workbooks.Add
ThisWorkbook.Activate
ThisWorkbook.Worksheets(1).Copy Before:=wbTemp.Worksheets(1)
wbTemp.SaveAs ("C:/Temp/pre_alert/Белгород.xls")
wbTemp.Close
With OutMail
.To = "мой@адрес.ru"
.Subject = "Тема сообщения."
.Body = "Тело письма."
.Attachments.Add ("C:/Temp/pre_alert/Белгород.xls")
.Send '.Save '.Display
End With
Kill ("C:/Temp/pre_alert/Белгород.xls")
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Добрый день!
Есть макрос, который должен открывать Excel файл и считывать данные в массив.

Код:
Public articul() As String, qt_osn() As String
Public FileXLS As Object
Public QToXLSWbk As Object

Public Sub qToXLS()

Set FileXLS = CreateObject("Excel.Application")
Set QToXLSWbk = FileXLS.Workbooks.Open(dir_in, , True, , , , True)
FileXLS.Visible = False

j = 10
i = 0
With FileXLS.ActiveSheet
While Not .Cells(j, 2).Value = 0
If .Cells(i, 2) = "№ пп" Or .Cells(i, 2) <> "" Then
articul(i) = .Cells(i, 4)
qt_osn(i) = .Cells(i, 5)
If i <= 10 Then j = 10
End If
i = i + 1
j = j + 1
Wend
End With


End Sub

Доброе утро! Имеется таблица весом в 70мб, необходимо ее вычистить от данных не меняя некоторые ячейки, создал макрос, с помощью записи, вот что получилось:

Код: Sub wwwwww()
'
' wwwwww ;
'
' : Ctrl+w
'
Rows("8:20068").Select
Selection.ClearContents
End Sub

Код: Sub xx()
For Each ws In Worksheets

ws.Activate
With ws
.Rows("8:20068").Select
Selection.ClearContents
End With

Next
End Sub

KF121
спасибо! Правда я просто у себя добавил Worksheets.Select после Rows("8:20068").Select и тоже заработало, теперь проблема, что таблица не ужалась, и так же 70мб весит...

compwork
Во-первых, Activate и Select - это лишнее. Лучше так:

Код: Sub xx()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Rows("8:20068").ClearContents
Next
End Sub

kser
Смотри: http://rghost.ru/38387625
На всякий случай прикрутил ещё вставку вместе с месяцем и года. Если не нужно, в коде уберёшь.

Добавлено:
unit4
Два вопроса:
1. Зачем создавать ещё один объект "Excel", когда ты уже в нём работаешь?
2. "dir_in" подразумевает полный путь и имя файла, который ты открываешь. Из твоего кода не видно откуда ты берёшь файл.

psiho

Цитата:

1. Зачем создавать ещё один объект "Excel", когда ты уже в нём работаешь?

ХЗ, в интернете так было. Я в VBA не спец, а времени на разработку всегда мало... Да и как бы мне необходимо токрыть другой файл, а не тот в котором макрос этот.

Цитата:

2. "dir_in" подразумевает полный путь и имя файла, который ты открываешь. Из твоего кода не видно откуда ты берёшь файл.

Отседова

Код:
Public dir_in As String
Public Sub openXLS()
dir_in = Application.GetOpenFilename("Excel file (*.xls), *.xls")
End Sub

unit4
Смотри: http://rghost.ru/38390256

psiho
Спасибо!

Добрый день. Есть макрос, который долгое время эмулирует нажатие клавиш на клавиатуре, ctrl+c, ctrl+v и другие. По непонятным для меня причинам перестает работать через некоторое время. Буфер обмена я чищу, возможно, забивается буфер клавиатуры, как его средствами vba почистить? Спасибо.

psiho Огромное спасибо.
Буду далее выпиливать (пока кажется знаю как сделать остальное).

Привет)
Ребят, помогите написать пару программ пожалуйста))
1. В первом столбце вывести N случайных целых чисел от -5 до 20 (N ввести с клавиатуры). Найти сумму чисел в столбце до первого положительного(включительно).
2. Сформировать матрицу А размером 10х10, заполнив ее случайными числами от -30 до 10. В массив В поместить элементы пятого столбца матрицы А. Вывести только элементы В с нечетными номерами.

Заранее спасибо)))

Цитата:

вывести N случайных целых чисел от -5 до 20

Код:
Randomize
Int(20 - (25 - 25 * Rnd))

Не могу никак справиться с ошибкой <B>402 Must close or hide topmost modal form first</B> в строке UserForm1.hide


Если питаюся скрыть вторую форму вилетает ета ошыбка, если зразу запустить первую форму то макрос работает нормально.

Код:
Private Sub CommandButton1_Click()
'ChooseForm.hide
'SIGN
Worksheets("Payments").Select
vfirst = ActiveSheet.UsedRange.Row
lastrow = vfirst + vfirst + ActiveSheet.UsedRange.Rows.Count - 1&

For Row = 2 To lastrow - 1

currentinvoice = CStr(UserForm1.TextBox2.Text)

If Trim(Worksheets("Payments").Cells(Row, 3)) = Trim(currentinvoice) Then
'MsgBox (Worksheets("Payments").Cells(Row, 3))

If Trim(Application.UserName) = "kaschnro" Or Trim(Application.UserName) = "shnytkol" Then
Worksheets("Payments").Cells(Row, 12) = Application.UserName
End If
If Trim(Application.UserName) = "kishchna" Or Trim(Application.UserName) = "babychna" Then
Worksheets("Payments").Cells(Row, 13) = Application.UserName
End If

If Trim(Application.UserName) = "vashchan" Or Trim(Application.UserName) = "klymok" Then
Worksheets("Payments").Cells(Row, 14) = Application.UserName
End If

If Trim(Application.UserName) = "korkundm" Or Trim(Application.UserName) = "klymok" Then
Worksheets("Payments").Cells(Row, 14) = Application.UserName
End If
End If
UserForm1.hide 'Здесь ошыбка
'ChooseForm.Show

Next
End Sub

Здравствуйте!
То-ли я не могу сформулировать правильно вопрос, то-ли ответа нет.. так или иначе у меня есть прайс такого вида:

Код:
Артикул;Наименование ;Цена
;Пылесос(кат) ;
1234 ;Samsung B-234 (моющий);2000руб

alexd73
Выложи файл с прайсом для примера

Доброго!

подскажите, как сделать, что бы в диапозон попадала область выделенная в данный момент. Сейчас задаю напрямую

Код: A = Range("a8:p2056")

Цитата:

подскажите, как сделать, что бы в диапозон попадала область выделенная в данный момент

В модуль "ЭтаКнига" добавляешь следующий код:

Код:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range
Set r = Target
End Sub

Уважаемые форумчане! Опять прошу вашей помощи, всегда уверен
в вашей компетентности ! Заранее благодарен Вам!
Вопрос следующий:
Есть три столбца данных в виде Excel-таблицы.
Второй и третий столбцы - текстовые данные.
В первом столбце двоичные данные: "0" или "1".
Нужно данные третьего столбца сместить следующим образом:
если в n-й строке первого столбца находится "1" - ничего не делать;
если "0" - начиная с n-й строки, все данные третьего столбца смещаются
на позицию вниз с образованием пустого поля, причем первый и второй столбцы
остаются неизменными.
Примечание:
- В третьем столбце кол-во непустых (информативных) строк меньше кол-ва строк таблицы на число, равное кол-ву нулей в первом
столбце, причем пустые строки идут в конце третьего столбца.

Интересует сам процесс записи (создания) макроса, я пытался записать более-менее
универсальный (для количества строк от 200 до 500) макрос, однако он работает некорректно.
Идея следующая:
1) Включаю запись макроса
2) ставлю курсор в ячейку третьего столбца, напротив "0".
3) правая клавиша - вставить ячейки (срока) - вставляется пустая строка
4) Выделяю весь первый и второй столбцы от пустой строки до конца - вырезаю-вставляю позицией выше
5) Стоп записи макроса.
Рад увидеть Ваши советы, решения.