» Excel VBA (часть 3)

vlth
Не подходит. мдб файл весит порядка 200 мегабайт. Архивация внешним софтом приводит к тому, что архивация запускается и долго и упорно висит в фоне не подавая никаких сигналов о том, завершена она или нет.

Цитата:

архивация запускается и долго и упорно висит в фоне не подавая никаких сигналов о том, завершена она или нет

Drazhar, ну так замените vbHide на vbMaximizedFocus, или что там Вас больше устроит...

vlth
Не подходит. мдб файл весит порядка 200 мегабайт. Архивация внешним софтом приводит к тому, что архивация запускается и долго и упорно висит в фоне не подавая никаких сигналов о том, завершена она или нет.

Цитата:

vlth
Не подходит. мдб файл весит порядка 200 мегабайт. Архивация внешним софтом приводит к тому, что архивация запускается и долго и упорно висит в фоне не подавая никаких сигналов о том, завершена она или нет.

Я эту фразу уже видел. Поэтому и предлагаю Вам сделать окно WinRar видимым.

Что значит "не подавая никаких сигналов", если WinRar выводит полную информацию о ходе процесса, включая ориентировочное время до его завершения?!
К тому же, используя в командной строке ключи для отправки архива по почте, можно вообще не дожидаться его окончания.

Добавлено:
Проверил способ упаковки, которым Вы пользуетесь. Вы считаете, что визуально он более информативен? - моментально показывается прогресс выполнения процесса 100%, а каков он на самом деле и когда ожидать его завершения - неизвестно.
Добавлю, что Этот способ тоже, по сути, использует "внешний софт".

Уважаемые, кто в курсе о проблеме с функцией LinEst?

Как я понимаю, эта функция недостаточно точно выдавала результат в некоторых случаях в версиях еще до Excel 2003. Как обстоят дела сейчас? И относится ли это к функции LinEst в VBA или это характерно только в Excel?

Буду очень признателен за ответ.

Drazhar
Попробуй сначала сделать compact

Код: Sub CompressIt()
Dim jro As JRO.JetEngine
jro = New JRO.JetEngine()
jro.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\SourceDB.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\DestDB.mdb;Jet OLEDB:Engine Type=5")
End Sub

dneprcomp
compact я и так делаю в другом модуле.
vlth
Проблема ко всему прочему лежит в том, что не у всех есть Рар. Кто-то юзает 7zip, а у кого-то вообще winzip classic

Добавлено:
vlth
Этот способ упаковки в данном случае лучше, так как независим от внешних упаковщиков(zip-папки - не внешний упаковщик) и плюс, он не дает дальше работать макросу пока архивация не завершится(ну не могу выделять минут по 10 на архивацию по максимуму)

Drazhar, дело хозяйское, конечно ))
Вы, кстати, не пояснили, что значит "в Win 2000 не работает"? - выдаёт ошибку?


Цитата:

плюс, он не дает дальше работать макросу пока архивация не завершится

В том-то и дело, что я при проверке кода после
Код: oApp.Namespace(ActiveWorkbook.Path & "\db.zip\").CopyHere ActiveWorkbook.Path & "\db.mdb"

vlth
проблема в том, что как выяснилось zip-папки без геморроя в win2000 не работают.

Добавлено:
vlth
Не вполне верно выразился. Правильность архивного файла проверяю следующим кодом

Код: 150 j = 1
160 Do Until oApp.Namespace(ActiveWorkbook.Path & "\db.zip\").items.Count = i
170 Application.Wait (Now + TimeValue("0:00:01"))
180 If j >= maxi Then
190 MsgBox "Отправка была прервана!", vbOKOnly + vbExclamation, "Quantor"
200 End
210 Else
220 j = j + 1
230 End If
240 Loop

Drazhar

Код: Dim fso As Object, File2 As Object, lngFSize As Long
Sub One()
Dim File1 As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ActiveWorkbook.Path & "\db.rar") Then _
fso.GetFile(ActiveWorkbook.Path & "\db.rar").Delete
Set File1 = fso.GetFile(ActiveWorkbook.Path & "\db.mdb")
Shell "C:\Program Files\WinRAR\WinRAR.exe a db.rar " & File1.Path ', vbHide
Application.Wait Now + TimeValue("0:00:10")
Set File2 = fso.GetFile(ActiveWorkbook.Path & "\db.rar")
Two
End Sub
Sub Two()
DoEvents
On Error GoTo ErrHnd
If File2.Size = lngFSize Then
MsgBox "Файл базы данных заархивирован", vbOKOnly + vbInformation, "Quantor"
lngFSize = 0: Set fso = Nothing: Set File2 = Nothing
Exit Sub
End If
Application.OnTime Now + TimeValue("0:00:02"), "Two"
lngFSize = File2.Size
Exit Sub
ErrHnd:
MsgBox Err.Description & "; Операция отменена?", vbOKOnly + vbQuestion, "Quantor"
lngFSize = 0: Set fso = Nothing: Set File2 = Nothing
End Sub

vlth
Может я чего-то недопонимаю, но откуда берется исхзодное значение lngFSize

Drazhar, изначально значение lngFSize равно нулю. После завершения первого запуска процедуры Two() lngFSize присваивается значение текущего размера создаваемого архива. Далее, при каждом запуске Two(), текущий размер архива сравнивается с предыдущим. Two() запускается до тех пор, пока размер архива не перестанет изменяться, что является признаком окончания архивации.
У меня запуск Two() происходит раз в 2 сек., но Вы смело можете, думаю, увеличить этот период.


Добавлено:

Цитата:

Проблема ко всему прочему лежит в том, что не у всех есть Рар. Кто-то юзает 7zip

Можно программно проверять наличие их экзешников (у 7zip режим командной строки также имеет место быть).
Что касается winzip classic - не знаю.

vlth
Грац. Сегодня попробую.

vlth

Цитата:

jurris, такой функции в VBA нет: это функция рабочего листа Excel (она же ЛИНЕЙН() ). Т.е., говоря иначе, если её применить в коде VBA (Application.WorksheetFunction.LinEst() ), её точность должна быть такой же, как и при вычислениях на листе.
Больше ничего добавить, к сожалению, не могу.

Спасибо.

А как можно порыться в исходном коде этой функции?
Интересно, есть такая возможность?
Наверно можно как-нибудь просмотреть библиотеку всех встроенных WorksheetFunction?

Цитата:

А как можно порыться в исходном коде этой функции?

Если это возможно, то уже точно не с помощью VBA

Подскажите, плиз, как лучше создать синхронные копии одного диапазона на нескольких листах, причем все изменения в эталоне должны отслеживаться в копиях. Через =смещ() не получается, т.к. при добавлении строки в эталон, размер копии не меняется (добавленной строки в копии не видно).

vchobo, оптимальное решение для Вашей задачи предложить не смогу, т.к. Вы дали слишком мало исходной информации.
Посмотрите в кач-ве примера это:
Код: Private Sub Worksheet_Deactivate()
With ThisWorkbook.Worksheets(1).Range("Мой_диапазон")
.Copy ThisWorkbook.Worksheets(2).Cells(1, 1)
.Copy ThisWorkbook.Worksheets(3).Cells(1, 1)
End With
End Sub

Цитата:

vchobo, оптимальное решение для Вашей задачи предложить не смогу, т.к. Вы дали слишком мало исходной информации.
Посмотрите в кач-ве примера это:
Код:
Private Sub Worksheet_Deactivate()
With ThisWorkbook.Worksheets(1).Range("Мой_диапазон")
.Copy ThisWorkbook.Worksheets(2).Cells(1, 1)
.Copy ThisWorkbook.Worksheets(3).Cells(1, 1)
End With
End Sub

Спасибо огромное vlth, то, что надо, а как сделать, чтобы копировались только значения, без формул?

vchobo, вот пример кода:
Код: For i = 2 To 3
With ThisWorkbook.Worksheets(i)
With Range(.Cells(1, 1), .Cells(20, 5))
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
End With
Next

Экселоводы, помомогите. есть такая таблица в которой хочу что б можно было со строками играться, вверх или вниз. например выбрал строку нужную и смещать её вниз или вверх, как это делается в менеджерах закачек. Можно ли такое как нибудь осуществить?

Sniper1, только через промежуточную строку или копи-паст. Если копи-паст, то перемещение вверх будет выглядеть так:

Код: Rows(ActiveCell.Row).Cut
Cells(ActiveCell.Row-1, 1).Insert Shift:=xlDown

Цитата:

For i = 2 To 3
With ThisWorkbook.Worksheets(i)
With Range(.Cells(1, 1), .Cells(20, 5))
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
End With
Next

Как его применить, понятно?

Спасибо, понятно, что копируется диапазон Range(.Cells(1, 1), .Cells(20, 5)) на i листов, а куда на листах копируется в те же (.Cells(1, 1), .Cells(20, 5))?

Цитата:

Sniper1, только через промежуточную строку или копи-паст. Если копи-паст, то перемещение вверх будет выглядеть так:

Код:
Rows(ActiveCell.Row).Cut
Cells(ActiveCell.Row-1, 1).Insert Shift:=xlDown

Соответственно перемещение вниз:

Код:
Rows(ActiveCell.Row).Cut
Cells(ActiveCell.Row+1, 1).Insert Shift:=xlUp

Сразу говорю - не тестил, писал "на живую нить" И защитных обвязок, как видишь, тоже нету (т.е. чтобы макрос не пытался перетащить вверх строку №1).

А не мог ли б вы прикрутить это всё на мою таблицу? а-то я в этом совсем слабоват. если вам конечно будет не трудно это сделать.

vlth
Спасибо. Все работает. Очень сильно выручил

Цитата:

vlth
Спасибо. Все работает. Очень сильно выручил

Вот кто б меня теперь выручил бы

vchobo

Цитата:

Спасибо, понятно, что копируется диапазон Range(.Cells(1, 1), .Cells(20, 5)) на i листов, а куда на листах копируется в те же (.Cells(1, 1), .Cells(20, 5))?

В этом примере диапазон Range(.Cells(1, 1), .Cells(20, 5)) копируется сам в себя специальной вставкой "только значения", т.е. без формул.

vlth

Цитата:

В этом примере диапазон Range(.Cells(1, 1), .Cells(20, 5)) копируется сам в себя специальной вставкой "только значения", т.е. без формул.

Спасибо, въехал наконец!
Может кто-то подскажет, сталкивался с такой проблемой:
создаю запрос ms sql (доступ по odbc)
SELECT ..............
FROM ..............
WHERE FILD_NAME LIKE '%Вася%'
Пишет синтаксическая ошибка!!!
Перебрал все возможные варианты обрамления *,%,&%, "', оператор LIKE отказывается работать.
В чем проблема? Если просто ставлю условие FILD_NAME='Иванов Вася', все нормально работает.
Устал гуглить, нашел древний пост 2004 г. http://forum.codenet.ru/archive/index.php/t-10164.html, моя проблема аналогична, но из него ничего не понял

vchobo

Код: WHERE FILD_NAME LIKE '%Вася%'

Подскажите пожалуйста, возможно ли с помощью VBA сделать привязку екселевского файла к железу по паролю? А может есть программы которые это делают. Как exe привязать я знаю, а вот с екселем заморока. Помогите плиз.

TohaDub, посмотрите здесь и здесь


Добавлено:
vchobo
А к какой СУБД запрос создаёте?