» Excel VBA (часть 2)

Wukuze
Попробуй так:
Sub Main()
Dim FS As FileSearch
Dim FilePath As String, FileSpec As String
Dim i As Integer
FilePath = "C:\Temp\" 'пусть это папка с файлами"
FileSpec = "*.xls" 'если нужно - поставить фильтр
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = FilePath
.FileName = FileSpec
.Execute
If .FoundFiles.Count = 0 Then
MsgBox "Файлы не найдены"
Exit Sub
End If
End With
For i = 1 To FS.FoundFiles.Count
Call ProcessFiles(FS.FoundFiles(i))
Next i
End Sub
Sub ProcessFiles(FileName As String)
Workbooks.Open FileName:=FileName
'исполняемый код для каждого файла сюда
ThisWorkbook.Close savechanges:=True
End Sub

спасибо огромное, очень помогли))

SAS888


Цитата:

Dim75
Вставь в модуль "Эта книга" следующий код:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Passw As String, x As String
Passw = "12345" 'пусть это пароль
If ActiveSheet.Index > 2 Then 'если № листа >2, например
If Date > #12/31/2007# Then 'дата окончания действия пароля
Sheets(1).Select
Exit Sub
End If
x = InputBox("Введите пароль")
If x <> Passw Then
MsgBox "Пароль неверный"
Sheets(1).Select
ThisWorkbook.Close savechanges:=False
End If
End If
End Sub
Нужно, конечно и проект защитить паролем.

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

как то бы еще в сохраняемом имени файла поставить переменную
ActiveWorkbook.SaveAs FileName:="c:\temp2\N.xml"
где N - переменная

Доброго времени суток!

У меня такой вопрос? Есть Прайс лист с которым необходимо сделать следующее.

1. Удалить строки в которых пуста заданная ячейка(например вторая)
2. Удалить строки в которых запись в заданной ячейки (опять же к примеру во второй) не соответствует заданному формату - типа такого AA1419026-E5 (значения могут быть разные).

хотя получается первый вопрос решится автоматически если решится второй.

Я начал делать вот такое:



Код:


Selection.SpecialCells(xlCellTypeBlanks).Select

For Each Rw In Selection.Rows
If IsEmpty(Selection......) Then
Selection.EntireRow.Delete
End If
Next Rw

micolo
Удалить, где-то так

Код:
Public Sub DeleteSelectionWithEmpty(ByVal inColumn As Long)
Dim LastRow As Long
LastRow = Selection.Rows.Count + Selection.Row - 1&
Range(Cells(Selection.Row, inColumn), Cells(LastRow, inColumn)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp
End Sub

Public Sub test()
DeleteSelectionWithEmpty 2
End Sub

Взял из предыдущих топиков такой пример функции, определяющей окончание столбца с записями

Public Function lrc(ws As Worksheet, c As Integer)
lrc = 1
Do While ws.Cells(lrc, c) <> ""
lrc = lrc + 1
Loop
End Function

Но не могу ею воспользоваться, точнее передать аргументы.
Запускаю процедуру свою

Sub pusk()
b = lrc(ws, c)
MsgBox b
End Sub

И получаю ошибку в виде "ws - ByRef argument type mismatch"

Подскажите пожалуйста, что я не так делаю

Добавлено:

Цитата:

Подскажите пожалуйста, что я не так делаю

Ребята разобрался - дописал ByVal перед аргументами и назначил активный лист
Set ws = ActiveSheet

1 вопрос по производительности системы. Как отменить автоматический пересчёт на конкретных листах? Application.Calculation = xlCalculationManual чтобы был только тех листах что мне нужно а на других автоматом? (предпологаю что это невозможно )

2 Можно ли оптимизировать код:


Код:
in_r.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

человеки! подкинь идейку как защитить книгу - обеспечить неработоспособность на другой машине. интрересует функция привязки к винчестеру если конечно такое возможно...

Люди, помогите пожалуйста.
Есть программа для вычисления амортизации (на VBA Access)
Необходимо переписать ее в Excel/
Проблема в том что с программированием у меня совсем беда, но очень надо - диплом горит.
Она совсем простенькая, но у меня почему-то ничего не получается.
Надеюсь на понимание и сострадание к ближним...

Макрос выполняю из одного файла открывая файл с именем file и получаю ошибку:
run time error 424 VBA

Код:
With Workbooks(file).Sheets("Summary")
Set .Range("K1", "K1").FormulaR1C1 = "=0" 'тут ошибка!
End With

vasiliy74


Цитата:

1Как отменить автоматический пересчёт на конкретных листах?

Справка рулит
[more]
EnableCalculation Property
SpecificsTrue if Microsoft Excel automatically recalculates the worksheet when necessary. False if Excel doesn't recalculate the sheet. Read/write Boolean.

Remarks
When the value of this property is False, you cannot request a recalculation. When you change the value from False to True, Excel recalculates the worksheet.
[/more]

Цитата:

2 Можно ли оптимизировать код:

Уже ж обсуждалось несколькими страницами ранее

Код:
in_r.Value = in_r.Value

AndVGri
Спасибо огромное!!! У меня просто прорыв! Спасибо, за то что не смотря на повтор вопроса получил ответ

Есть ещё вопрос:
Можно ли оптимизировать работу excel тем, что если окно Приложения не активно, то вычисления останавливать?

Прошу прощения, если сей вопрос уже пробегал в обсуждении - не нашел.
Проблема такова - есть сервер, формирующий файл в формате, близком к CSV. Разобрать файл "локально" - проблемы нет. Беда в другом - хочется непосредственно Excel-ем тянуть его с сервера (то есть иметь в файле кнопку "Обновить данные", которая бы скачивала файл с сервера и "разбирала" его).

Вопрос: каким кодом можно скачать файл с сервера (по HTTP)?

Заранее всем спасибо за ответы. Можно даже не код, а хотя приверно направление "куда копать"...

andysh
В принципе, должен открывать по обычному
Workbooks.Open "http://xxx.yyy.zz/filename.csv"
К сожалению, бесплатные хостинги не позволяют на прямую качать файл, чтобы дать 100% ответ, все грузят страницу загрузки файла, может в Вашем случае, всё будет проще

Как записать присвоение переменных типа Range?:
out_r.Value = in_r.Value
Где out_r больше чем in_r ?? у меня те ячейки что выходят за пределы заполняются #N/A? Как этого избежать?

Что если будет обратная ситуация in_r больше чем out_r? Как это можно увидеть что бы избежать потери данных?

Dim75
А так устроет? При открытии книги запрашивается пароль (если дата не истекла), при верном вводе пароля листы отображаются. При закрытии книги - скрываются.
Private Sub Workbook_Open()
Dim Passw As String, x As String
Dim Item As Worksheet
Passw = "12345" 'пусть это пароль
If Date < #12/31/2007# Then 'дата окончания действия пароля
x = InputBox("Введите пароль")
If x <> Passw Then
MsgBox "Пароль неверный"
Sheets(1).Select
Else
For Each Item In ActiveWorkbook.Worksheets
Item.Visible = True
Next Item
End If
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets(...).Visible = False 'спрятать нужные листы
...
End Sub

Добавлено:
Wukuze

Цитата:

в сохраняемом имени файла поставить переменную

Вместо строки
Цитата:

ThisWorkbook.Close savechanges:=True

Используй:
Переменная N - имя текущего файла
ActiveWorkbook.SaveAs Filename:="C:\temp2\" & N & ".xml"

Добавлено:
donarc
А не прощще:
LastRowInColumn = ActiveSheet.Range("A65536").End(xlUp).Row 'для столбца A, например?

Подскажите, пожалуйста, как проще решить задачу с использованием VBA.
пример в прикрепленном файле.
спасибо.

http://rapidshare.com/files/72324687/2.xls.html

Gluzer
Можно, достаточно просто, привязаться к имени компьютера, использовав:
CompName = Environ("COMPUTERNAME")

SAS888, спасибо огромное

ol7ca
Посмотри решение здесь: http://slil.ru/25149082

SAS888

Нарыл определенный макрос идеально подходит условие ввода пароля, скрытие листов, но вот как прикрутить условие по закрытию файла после даты ...

т.е есть макрос с пользовательской формой

Private Sub Workbook_Open()
Load UserForm1
UserForm1.Show
End Sub

нужно прикрутить

Sub Workbook_Open()
If Date <= #12/31/2004# Then Exit Sub
MsgBox "Сейчас рабочая книга будет закрыта!"
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Тут должно быть закрытие
.Close False
End With
End Sub

в общем как их увязать вместе

Dim75
Не понял проблемы. Где-то внутри Вашего макроса и нужно вставить условие по дате.

Цитата:

If Date <=

и т.д.


Добавлено:
А как на счет моего предложения на предыдущей странице?

SAS888

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

Трудность в привязке в том, что вставляю данное условие на дату, а форма для ввода пароля не уходит с экрана, т.е. последовательности в макросе чет не завершены

Dim75
А что, Unload UserForm1 не помогает?

SAS888

посмотри плиз, а то я не разбираюсь )
http://slil.ru/25149399

Ребята! подскажите как у VBA удалить все кнопки.

Dim75
Посмотри здесь: http://slil.ru/25149579

SAS888

Спасибо огромноё, всё работает как хотелось !!! )

hackman
Если речь идет о кнопках - элементах управления на рабочем листе, то можно так:
ActiveSheet.Shapes.SelectAll
Selection.Delete
Можно и для всей книги.