Ошибка "400" vba excel

[Asya]

Добрый день.
Вопрос такой возникает ошибка "400" при работе с кодом. До этого я писала свой код и получала такую же ошибку, но этот код взят из книги. Что это за ошибка и как с ней бороться?

Sub FindAndSelect()
Dim strStartAddr As String ' Хранит координаты первого найденного значения
Dim rgResult As Range
' Поиск первого входжения искомого слова
Set rgResult = Range("Bl:B10").Find("Прибыль", , xlValues)
If Not rgResult Is Nothing Then
' Сохраним адрес найденной ячейки (чтобы контролировать зацикливание поиска)
strStartAddr = rgResult.Address
End If
Do While Not rgResult Is Nothing
' Обработка результата поиска
rgResult.Interior.Color = RGB(255, 255, 0)
' Новый поиск
Set rgResult = Range("Bl:BIO").FindNext(rgResult)
If rgResult.Address = strStartAddr Then
' Поиск завершен
Exit Do
End If
Loop
End Sub

[pashulka]

Если пример был скопирован из книги без изменений, то откуда взялась столь странная адресация … "Bl:B10" и "Bl:BIO" Что же касается ошибки, то предлагаю скачать пример, где подобного безобразия не наблюдается.

[Asya]

Большое спасибо. А пример правда из книжки без изменений Книга А. Гладкий, А. Чиртик "Эффекты и трюки Excel".

[pashulka]

В печку такую книгу, тем паче, что эта книга содержит ворованный материал.

[Игорь Акопян]

налицо работа распознавалки текстов... печально...

[GreyW]

У меня тоже ошибка 400. Помогите пожалуйста. Вот код:

Код: Выделить всё

'---------------------------------------------------------------------------------------
' Procedure : Поиск_подстроки_в_файлах
' DateTime  : 01.06.13 15:05
' Author    : Администратор
' Purpose   : Поиск подстроки по файлам в текущей папке и копирование найденой строки
'---------------------------------------------------------------------------------------
'
Public Sub Поиск_подстроки_в_файлах()

' Переменные
Dim bookname As String, sheetname As String   'Переменные "Имя книги" и "Имя листа"
Dim sh_in As Worksheet, sh_out As Worksheet         'Два указателя на рабочие листы
Dim sFolder As String, sFiles As String, ac As Long
Dim FindStr As String   'Что будем искать
Dim r As Long, c As Long
Dim inRow As Long, inCol As Long, outRow As Long, outCol As Long
Dim PastedItems As Integer
PastedItems = 0

' Отключаем все события
With Application
  'отключаем обновление экрана - это убыстрит работу макроса
  .ScreenUpdating = False
  'отключаем события книги
  .EnableEvents = False
  'включаем ручной пересчёт формул - это убыстрит работу макроса
  ac = .Calculation: .Calculation = xlCalculationManual
End With

' Выбор папки где лежат файлы
With Application.FileDialog(msoFileDialogFolderPicker)
  If .Show = False Then Exit Sub
  sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
sFiles = Dir(sFolder & "*.xls*")

' Ввод искомой строки
FindStr = InputBox("Что будем искать?", , FindStr)

' Инициализируем активный лист как получатель
sheetname = ActiveSheet.Name                  'Имя листа взять у ативного листа
bookname = ActiveWorkbook.Name                'Имя книги взять у активной книги
Set sh_in = Workbooks(bookname).Worksheets(sheetname)    'Указать на активную книгу и лист по их именам

' Перебираем файлы в текущей папке
Do While sFiles <> ""
' открываем книгу источник
Workbooks.Open sFolder & sFiles

' Инициализируем первый лист открытой книги как источник
' Здесь возможно ошибка !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'
Sheets(1).Select           ' Выбираем первый лист
Set sh_out = ActiveSheet   ' Указать на активный лист

' Поиск последней заполненной ячейки в приемнике
With sh_in.UsedRange
  inRow = .Row + .Rows.Count - 1
  inCol = .Column + .Columns.Count - 1
End With

' Поиск последней заполненной ячейки в источнике
With sh_out.UsedRange
  outRow = .Row + .Rows.Count - 1
  outCol = .Column + .Columns.Count - 1
End With

' Перебираем строки источника
With sh_out 'Указать на лист-источник
  For r = 1 To outRow

' Перебираем столбцы источника
    For c = 1 To outCol

' Проверяем присутствует ли искомая подстрока
      If InStr(1, .Cells(r, c), FindStr, vbTextCompare) > 0 Then

' Копируем всю найденую строку
        .Rows(r).Copy
        
' Вставляем всю скопированную строку в конец приёмника
' Для копирования только значений .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        sh_in.Rows(inRow + 1).PasteSpecial
' Увеличиваем значение последней строки приемника
        PastedItems = PastedItems + 1
        inRow = inRow + 1
      End If
        
' Конец цикла перебора столбцов
    Next c
' Конец цикла перебора строк
  Next r
End With

' Конец цикла перебора файлов
ActiveWorkbook.Close True
sFiles = Dir
Loop

'возвращаем назад всё отключенное/изменённое
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = ac
End With
MsgBox "Найдено " & PastedItems & " значений."
End Sub

[koyeha]

Вопрос такой возникает ошибка "400" при работе с кодом. До этого я писала свой код и получала такую же ошибку, но этот код взят из книги. Что это за ошибка и как с ней бороться??????



=== Solitaire ===

[pashulka]

koyeha, Предлагаю не исправлять чужие ошибки, а создавать свои А если серьёзно, то просто опишите свою задачу и тогда, возможно, кто-нибудь запостит готовое решение.