» Excel VBA (часть 2)

Цитата:

Единственное, макросы не будут иметь доступ на запись к защищённым ячейкам

В этом-то и проблема


Цитата:

Если коротко, то далее...

А вот за это большое спасибо!

Добавлено:
ЗЫ

Никто не знает, как скрыть надписи "страница 1", "страница 2" и т.д. в режиме разметки страницы?

Добавлено:
И вот ещё.

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

gamers_hater
В VBA Excel есть обработка события активации рабочего листа:
Private Sub Worksheet_Activate()
Range("D5").Select ' выделяем нужную ячейку
End Sub

SAS888
Спасибо!

Подскажите, плиз, как в цикле пробежаться по всем листам в книге, не зная при этом имен листов?

Roka
Вариант 1:

For i=1 To ActiveWorkbook.Sheets.Count
Cells(i,1)=Sheets(i).Name
Next

Вариант 2:

For Each sht In ActiveWorkbook.Sheets
MsgBox sht.Name
Next Sht

SAS888
спасибо, сейчас попробую

Попробовал, работает, спасибо.

Roka
Я только что отвечал на этот вопрос. Можно было пару страниц назад посмотреть.

Добавлено:
К старшим: может в шапку добавить свежие идеи?

вот, по рассылки [Solme] приползло...

Microsoft избавляется от Visual Basic for Applications

[more]
http://www.cybersecurity.ru/software/39559.html

Microsoft медленно, но верно искореняет из новых версий офисного
продукта Microsoft Office систему, которая некогда была одним из
основных компонентов этого программного обеспечения - Visual Basic for
Applications. В Microsoft признают, что со времен Office'95 именно VBA
были основным средством создания продвинутых инструментов, помогавших
создавать несложные программы для работы с офисными документами, кроме
того, именно VBA служил средством для написания макросов.
Макро-расширение языка Visual Basic оказалось настолько гибким, что на
его основе даже создавались вирусы.

Напомним, что VBA является интерпретируемым языком. Как и следует из его
названия, VBA близок к Visual Basic, но может выполняться лишь в рамках
приложения, в которое он встроен. Кроме того, он может использоваться
для управления одним приложением из другого, с помощью OLE Automation
(например, таким образом можно создать документ Word на основе данных из
Excel).

До сих пор VBA полноценно поддерживался в Windows-версиях пакетов
Microsoft Office, однако в последней версии Office 2007 VBA уже
поддерживается формально, а в новой версии Office 2008 for Mac, которая
выпущена сегодня, эта система и вовсе отсутствует. Ряд разработчиков
отмечают, что с этим нововведением в одной корпоративной среде
использование Office 2007 для Windows и Office 2008 для Mac крайне
проблематично, так как масса корпоративных пользователей зачастую
используют различные программные дополнения и надстройки для Microsoft
Office.

Однако в Microsoft не намерены останавливаться на достигнутом и удалить
VBA и из Windows-версии Office. Известно, что пользователи этой ОС
получат новую версию офисного пакета к середине 2009 года и в ней не
будет и следов VBA.

Также в Microsoft сообщили о том, что более не будут лицензировать VBA
для разработки приложений. Разработчикам же корпорация посоветовала
применять более новые системы Visual Studio Tools for Applications (VSTA)
или Visual Studio Tools for Office (VSTO). На днях на сайте Microsoft
были опубликованы новые материалы по использованию предлагаемых для
перехода средств.

До сих пор в подразделении Microsoft по разработке программного
обеспечения для Mac всячески отказывались от комментариев на тему отказа
от VBA, даже несмотря на протесты пользователей и разработчиков, а также
предупреждения аналитиков об оттоке ряда пользователей, применяющих этот
язык. Теперь же в корпорации говорят, о том, что Mac Office было
довольно проблемно портировать на Mac Intel, а переделать уже
существующие приложения на VBA в платформе Mac вообще невозможно, кроме
того, перенос VBA на новую платформу Mac вызвал бы еще большие задержки
с релизом офисного пакета.

Пользователям Mac-версии корпорация порекомендовала использовать систему
Apple Script, как заменитель VBA, однако эти среды между собой не
совместимы.

В корпорации отмечают, что уход от VBA вызван несколькими вескими
причинами. Во-первых, этот язык довольно уязвим с точки зрения
безопасности, во-вторых, по сравнению с Microsoft .Net он имеет скудную
функциональность, особенно в плане работы с интернетом.

[/more]
извините, если уже было раньше. вроде тут не видел...

В зависимости от чека на форме в коде должно считаться:
Если чек тру:
...If A > B then
...
Если чек фальш:
...If A < B then
...

Вопрос: Как в код программы подсунуть необходимый знак (chr(60) или chr(62)) ? Не хотелось бы раздваивать код который будет отличаться только одним знаком, тем более код - большой.

SERGE_BLIZNUK

Цитата:

Microsoft избавляется от Visual Basic for Applications

Добавлено:
visual73

Цитата:

Как в код программы подсунуть необходимый знак (chr(60) или chr(62))

Однако, не совсем понял.... Может XOR поможет?

Код: dim check as boolean
check=form1.CheckBox1.value
If check XOR A > B then
...

nick7inc
Не совсем то, потому что я не очень ясно объяснил.
------------
Я могу сделать проверку

если Check = True то запустить Процедуру_1
если Check = False то запустить Процедуру_2.

Sub Процедуру_1 ()
...
If A > B Then
...
End Sub

Sub Процедуру_2 ()
...
If A < B Then
...
End Sub

Но я хотел объединить эти две процедуры, т.к. они очень большие, а отличаются только знаками сравнения между A и B. Как это сделать?


Добавлено:
Есть решение !


Цитата:

передавай множитель m= 1 или -1, и используй одну проверку
m*A>m*B, тогда

1*A>1*B это A>B
-1*A>-1*B это A<B

visual73
А я что предложил? Немного длиннее, конечно, но всё же одной процедурой, хотя если условие проверяется много раз, то везде менять надо (или присвоить булевой переменной результат, который использовать где надо):
Код: If (A > B xor Check) AND not (A=B) Then ...

Код: For Each cell1 In data

nick7inc
Спасибо!

Мне еще надо было такой вариант

...для check = true чтоб работало
If A > B then...
а для check = false, чтоб работало
If A => B then... ?

Я сделал ... if A> B or A=m*B then ...

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

visual73

Цитата:

...для check = true чтоб работало
If A > B then...
а для check = false, чтоб работало
If A => B then... ?

Код: Dim check as boolean
...
if A>B OR (NOT(check) and A=B) then ...

Помогите пожалуйста скриптом или хотя б советом.
Проблема такая:
В сетевой папке лежал файл со списком договоров, с гиперссылками на их отсканированные версии. В какой-то момент (непонятно отчего) все ссылки изменились
с ".\Имя_папки\имя файла" на c:\documents and setings\ temporary internet files...Имя_папки\имя файла.
Как исправить все ссылки обратно? Их несколько тысяч, вручную, сами понимаете. Автозаменой не получилось, мож какой макрос или типа того?.\

По сути операция несложная- в адресе каждой гиперссылки отрезать кусок определенного образца, но на VB только "hello, world!" писал Подскажите кто что сможет!



h t t p ://rapidshare.com/files/79195661/______.xls
Файл с примером. Первые три строчки- неправильные гиперссылки (на папку documents and settings) четвертая для примера- как должно быть. Т.е. файлы на которые ссылаешься лежат в папке с самим екселевским файлом но в подпапках.

yx0

Цитата:

Помогите пожалуйста скриптом

Пробуй

Добавлено:
Делайте бекап почаще, у меня с сетевой папкой много раз файлы гробились (в труху превращались).

vasiliy74
Если "data" - это имя диапазона (а если нет, то присвоить имя), то можно присвоить имя первому (или нужному) столбцу и перебирать элементы, принадлежащие пересечению этих диапазонов. Например:

Columns(1).Name = "MyCol"
Set x = Intersect(Range("data"), Range("MyCol"))

For Each Cell In x
' Ваш код
Next Cell

SAS888
спасибо!
помогите разобрать с XML [more=Код]
Код:
Sub GetUSD()
'
' Here is a macro to get USD rate from Central Bank of Russia official site
' It also can get any other currency rate.
'
' &#209;&#239;&#224;&#241;&#232;&#225;&#238; &#226;&#238;&#242; &#253;&#242;&#232;&#236; &#228;&#226;&#243;&#236; &#244;&#238;&#240;&#243;&#236;&#224;&#236; &#231;&#224; &#240;&#224;&#225;&#238;&#247;&#232;&#233; &#248;&#224;&#225;&#235;&#238;&#237;:
' http://www.relib.com/forums/thread801546.aspx
' http://www.plisco.ru/soft/usd.html
'


Dim url_request As String
Dim nodeList As Object
Dim xmldoc As Object
Dim xmlNode As Object
Dim node_attr As Object
Dim i As Integer
Dim strDate As String
Dim USD As String
Dim Dollar As String
Dim uDate As String

' &#194;&#251;&#225;&#238;&#240;&#234;&#224; &#239;&#224;&#240;&#224;&#236;&#229;&#242;&#240;&#224; (&#228;&#224;&#242;&#251;, &#228;&#235;&#255; &#234;&#238;&#242;&#238;&#240;&#238;&#233; &#226;&#251;&#255;&#241;&#237;&#255;&#229;&#242;&#241;&#255; &#234;&#243;&#240;&#241; &#214;&#193;) &#232;&#231; &#241;&#239;&#229;&#246;&#232;&#224;&#235;&#252;&#237;&#238;&#233; &#255;&#247;&#229;&#233;&#234;&#232; &#242;&#224;&#225;&#235;&#232;&#246;&#251; -- C2
Range("G4").Select
uDate = ActiveCell.Value

' &#199;&#224;&#239;&#240;&#238;&#241; &#234; &#241;&#229;&#240;&#226;&#229;&#240;&#243; &#214;&#193;&#208;
Set xmldoc = CreateObject("Msxml.DOMDocument")
xmldoc.async = False
url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(uDate, "dd\/mm\/yyyy")

If Not xmldoc.Load(url_request) = True Then
MsgBox ("&#196;&#238;&#234;&#243;&#236;&#229;&#237;&#242; &#237;&#229; &#231;&#224;&#227;&#240;&#243;&#230;&#229;&#237;")
Exit Sub
End If

' &#206;&#225;&#240;&#224;&#225;&#238;&#242;&#234;&#224; &#239;&#238;&#235;&#243;&#247;&#229;&#237;&#237;&#238;&#227;&#238; &#238;&#242;&#226;&#229;&#242;&#224;
Set nodeList = xmldoc.selectNodes("ValCurs")
Set xmlNode = nodeList.Item(0).CloneNode(True)
Set node_attr = xmlNode.Attributes(0)
strDate = node_attr.Value
Set nodeList = xmldoc.selectNodes("*/Valute")
For i = 0 To nodeList.Length - 1
Set xmlNode = nodeList.Item(i).CloneNode(True)
If xmlNode.childNodes(1).Text = "USD" Then
USD = xmlNode.childNodes(4).Text
Dollar = "&#202;&#243;&#240;&#241; &#228;&#238;&#235;&#235;&#224;&#240;&#224; &#237;&#224; " & uDate & " &#243;&#241;&#242;&#224;&#237;&#238;&#226;&#235;&#229;&#237; " & strDate & ": " & USD & " &#240;&#243;&#225;&#235;&#229;&#233; &#231;&#224; " & xmlNode.childNodes(2).Text & " &#228;&#238;&#235;&#235;&#224;&#240;"
Exit For
End If
Next
MsgBox Dollar
USD = Replace(USD, ",", ".")
Range("K1") = USD
' &#206;&#244;&#238;&#240;&#236;&#232;&#242;&#229;&#235;&#252;&#241;&#242;&#226;&#238;
'Range("A2").Select
'USD = Replace(USD, ",", ".")
'ActiveCell.FormulaR1C1 = CDbl(USD)
'Range("B2").Select
'Dim sDD As Date
'sDD = Replace(strDate, ".", "/")
'ActiveCell.FormulaR1C1 = Format(sDD, "dd/mm/yyyy")

End Sub

nick7inc
Спасибо! Скрипт отлично сработал!
Тыщу раз спасибо!

yx0
Ну и чудненько. [more=Код для архива]
Код: Private Sub CommandButton1_Click()
Dim ws As Worksheet, R As Range, wt1 As String, wt2 As String
Dim cells1 As Range, hp As Hyperlink, i As Long
Dim search_what As String, replace_with As String

i = 0
wt1 = Script.cells(3, "B").Text 'Диапазон - начало "G1"
wt2 = Script.cells(4, "B").Text ' Диапазон - конец    "G4"
On Error GoTo err1
Set ws = Workbooks(Script.cells(1, "B").Value).Worksheets(Script.cells(2, "B").Value)
Set R = ws.Range(ws.Range(wt1), ws.Range(wt2))
On Error GoTo 0

search_what = Script.cells(5, "B").Text
replace_with = Script.cells(6, "B").Text

For Each cells1 In R
For Each hp In cells1.Hyperlinks

wt = hp.Address
If InStr(wt, search_what) > 0 Then i = i + 1
wt = Replace(wt, search_what, replace_with, , 1)
hp.Address = wt

Next hp, cells1

Script.cells(7, "B").Value = i 'Кол-во замен
MsgBox "Операция завершена успешно", vbExclamation, "Ку!"

Exit Sub
err1:

MsgBox Err.Description, vbCritical, "Проверьте вводимые данные"
If Err.Number = 9 Then MsgBox "Похоже, что не найдена книга или страница в ней", vbInformation

End Sub

Код: Workbooks.Open Filename:= _
"\\10.50.0.122\c$\Documents and Settings\noname\My Documents\E.xls"
With Worksheets("Data")
Set out_r = .Range("A1", .Range("IV1"))
End With

vasiliy74

Цитата:

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

Думаю, что нет. При создании объекта типа Range надо указывать книгу и лист. Если указать несуществующие, то получим ошибку Out of range или Method 'Range' of object 'Global' failed. В вашем примере лист с именем Data будет искаться в текущей книге (в той, что макрос сделан).

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

http://slil.ru/25403715

Добавлено:
Подскажите, пожалуйста,
имею файл с кучей листов и на каждом листе таблицы (по 17 столбцов), в которых актуальные данные за 12 месяцев текущего года, мне нужно:
1.    скопировать одну эту таблицу (можно выделить столбцы ) и вставить ее на этом же листе правее в определенное место (к примеру, первая ячейка оригинальной таблицы начинается в столбце B и скопировать надо в CA и еще в DA) таким образом получится 3 таблицы: актуальные данные, бюджет, прошлый год.
2.    вставить в определенное место в начале листа 4 новые таблицы, где таб. №2 это копия первых трех столбцов из основной таблицы текущего листа с сохранением всех форматов. А таб. 1, 3, 4 должны принять формат той таблицы (на каждом листе своя таблица, они все по 17 столбцов, но строки и данные разные ), куда будут вставлены. При этом, таб. 1, 3, 4 имеют формулы, где вычисляются данные из трех основных таблиц: актуальные данные, бюджет, прошлый год. Формулы должны стоять только в тех строках, где имеются числа в основных трех таблицах на той же строке.

Мне нужно это применить ко всем листам, в перспективе возможно увеличение (уменьшение) количества листов.
Примеры таблиц в присоединенном файле.

Буду благодарен за помощь в решении этой задачи.

ol7ca
Давайте по порядку.
1) Вам надо единовременно для одного листа сделать операцию, или пройтись по всем листам книги?
2) Копирование таблицы [more=код]
Код: ' указатели на объект типа Range и worksheet
Dim r1 As Range, r2 As Range, ws As Worksheet

' Выбираем лист, с коорым будем работать
'(в последствии можно
' пробегать по всем листам книги).
' вместо ThisWorkbook можно вставить что-то
' вроде Workbooks("MyBook.xls")
Set ws = ThisWorkbook.Sheets("Лист1")

' Возможные варианты задания диапазонов-источника
' и приёмника:
'Set r1 = ws.Range("B2:C5")
'Set r2 = ws.Range("E6:F9")
' или так
'Set r1 = ws.Range(ws.Cells(2, "B"), ws.Cells(5, "C"))
'Set r2 = ws.Range(ws.Cells(6, "E"), ws.Cells(9, "F"))
' или так
'Set r1 = ws.Range(ws.Cells(2, 2), ws.Cells(5, 3))
'Set r2 = ws.Range(ws.Cells(6, 5), ws.Cells(9, 6))
' или так для выделения столбцов
Set r1 = ws.Range(ws.Columns(2), ws.Columns(3))
Set r2 = ws.Range(ws.Columns(5), ws.Columns(6))

r1.Copy r2

nick7inc

Цитата:

Если надо вставить только значения

r2.Value = r1.Value - не проще?

nick7inc
спасибо
завтра попробую применить


Цитата:

Вам надо единовременно для одного листа сделать операцию, или пройтись по всем листам книги?

надо по всем листам книги

AndVGri

Цитата:

r2.Value = r1.Value - не проще?

Возьму на заметку.

Добавлено:
ol7ca

Цитата:

надо по всем листам книги

[more=код]
Код: Dim ws As Worksheet, wb As Workbook
Set wb = Workbooks("Книга1.xls") 'Присваивание для объектов

For Each ws In wb.Worksheets
If ws.Type = xlWorksheet Then
' [здесь вставляем вызов кода, который должен
' пройтись по всем листам типа Worksheet]
'Пример, на все листы в ячейку A3 написать "Packman"
ws.Cells(3, "A").Value = "Packman"
end if
Next ws
Set wb = Nothing ' Правило хорошего тона для всех объектов после использования

Подскажите как получить системный десятичный разделитель?
Команды

Код: Application.International(xlDecimalSeparator) и
Application.DecimalSeparator