Вопрос по VBA Excel

Yanvladimirovich

Как на VBA Excell устроить, чтобы была подпрограмма, работающая примерно так:

Code:

Set ws = Worksheets("Отчёт")
FormatRange(ws.Range("A1"))
FormatRange(ws.Range("B10:C20"))
...

Т.е. как организовать передачу Range в подпрограмму? Все мои старания упираются в ошибку Object required (Error 424). Понятно, вопрос синтаксиса, но что-то никак не выходит, не по ссылке, никак.

Viktor_

Sub Macro1() ' Kakaja-to programma
Set ws = Worksheets("Sheet1")
x = FormatRange(ws, "A1") ' Prisvoenie Range peremennoj
Call FormatRange(ws, "B10:C20") ' Vyzov podprogrammy
End Sub

Function FormatRange(w, a) ' Podprogramma
FormatRange = w.Range(a)
End Function

BORLAND

Private Sub ZFormatRange(ws As Worksheet, ZRange As String)
Sheets(ws.Name).Range("A1").Value = 100
Sheets(ws.Name).Range(ZRange).Value = 1000
End Sub

Удобнее
Private Sub ZFormatRange_1(ws As String, ZRange As String)
Sheets(ws).Range(ZRange).Value = 1000
End Sub

Private Sub CommandButton1_Click()
Dim Z As Worksheet
Set Z = Sheets("Лист1")
Call ZFormatRange(Z, "A1:A2")
call ZFormatRange_1("Лист1","B1:B2")
End Sub

Чтобы динамично обрабатывать диапазоны в Рабочей книге Excel удобно работать так:

Sheets(MainSheet_1).Range(Cells(RRow, RCol), Cells(RRow, RColCount)).Interior.ColorIndex = 15

Либо так =
Public Sub ZClearSheet(SheetName As String, RowStart As Long, RowEnd As Long)
Sheets(SheetName).Range("A" & CStr(RowStart) & ":BW" & CStr(RowEnd)).Clear
End Sub

Call ZClearSheet(MainSheet_1, 15, 65536)

G

Уважаемые!
Не пользуйтесь пожалуйста никогда, слышите никогда в коде определением листа по имени и ссылками на диапазоны стиля A1:B2.
Для объекта каждого листа есть переменная и вместо Set ws = Worksheets("Отчёт") проще и надежней использовать Set ws = Лист1, можно даже поменять CodeName у листа и вообще будет красиво:
FormatRange(Report.Cells(1,1))

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

Вот пример функции для удаления строк в диапазоне данных (из работающей книги, поэтому там немного больше, чем нужно для общего случая):

Code:

Sub DelLines(ASheet As Worksheet, DeletionRng As Range)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Finish
    
    Dim AOSheet As Object
    Set AOSheet = ASheet
    
    Dim DataRng As Range
    Set DataRng = AOSheet.SpecialRange("DATA")
    
    If Not Intersect(DataRng, AOSheet.SpecialRange("TOP")) Is Nothing Or _
       Not Intersect(DataRng, AOSheet.SpecialRange("BOTTOM")) Is Nothing Then
        GoTo Finish
    End If
    
    Dim Row As Range
    Dim DeletionRows As Range
    Dim DeletionRange As Range
     

    On Error GoTo BadRange
    
    
    Set DeletionRange = Intersect(DataRng, DeletionRng)
    
    On Error GoTo 0
    'On Error GoTo Finish
    
    GoTo GoodRange

BadRange:
        On Error GoTo 0
        Output "Выделенная область находится вне диапазона данных!", vbInformation
        GoTo Finish
GoodRange:
    
    On Error GoTo Finish
    
    UnProtectSheet ASheet
    
    For Each Row In DeletionRange.Rows
        If DeletionRows Is Nothing Then
            Set DeletionRows = Row.EntireRow
        Else
            Set DeletionRows = Union(DeletionRows, Row.EntireRow)
        End If

    Next Row

    If Not DeletionRows Is Nothing Then
        DeletionRows.Rows.Delete
    End If
    AOSheet.SpecialRange("BOTTOM").Activate
    
Finish:
    Application.ScreenUpdating = True
    
    If Err.Number <> 0 Then Output "Ошибка при удалении строк на листе """ & ASheet.Name & """.", vbCritical

    On Error GoTo 0
    
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
    
    ProtectSheet ASheet
End Sub

и ее вызов:

Code:

Private Sub DelLinesBtn_Click()
    Activate
    DelLines ActiveSheet, Selection
End Sub

G

BORLAND написал:

Либо так =
Public Sub ZClearSheet(SheetName As String, RowStart As Long, RowEnd As Long)
Sheets(SheetName).Range("A" & CStr(RowStart) & ":BW" & CStr(RowEnd)).Clear
End Sub

Call ZClearSheet(MainSheet_1, 15, 65536)

Тогда уж как-то так, чтоб для Excel 2007 переписывать не пришлось:

Code:

Public Sub ZClearSheet(Sh As WorkSheet, RowStart As Long, RowEnd As Long)
    Sh.Range(Sh.Rows(RowStart), Sh.Rows(RowEnd)).Clear
End Sub

Update
Только что обратил внимание на название функции -- зачет

bwbams

коротко так

sub FormatRange ( byref ws as Worksheet, byref r as Range )
....
end sub

ошибка, связанная с передачей объекта Range была вызвана скорее всего с тем, что по умолчанию
VBA передает такие объекты по ссылке (byref), поэтому надо сначала присвоить Range переменной, а
потом ее передавать параметром.

Dim myRange as Range
set myRange = MyWorksheet.Range("A1")

а потом уже вызывать

call FormatRange ( myRange )

G

Проблема в чем-то другом, приведенный ниже код работает на ура.

Code:

Sub FormatRange(r As Range)
   r.Cells(1, 1).Value = "12"
End Sub


Sub TST()
  FormatRange (ActiveSheet.Range("A1"))
End Sub

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

Code:

Sub ObjByVal(ByVal r As Range)
   r.Cells(1, 1).Value = "ObjByVal()"
End Sub

Sub TstVal()
  ActiveSheet.Range("A1").Value = "TstVal()"
  ObjByVal ActiveSheet.Range("A1")
  MsgBox CStr(ActiveSheet.Range("A1").Value)
End Sub

Результат:

Code:

---------------------------
Microsoft Excel
---------------------------
ObjByVal()
---------------------------
ОК   ---------------------------

Обновлено
Попробовал вот так:

Code:

Sub FormatRange(r As Range)
 r.Cells(1, 1).Value = Now
 Set r = ActiveSheet.Range("A2")
 r.Cells(1, 1).Value = Now - 1
End Sub

Sub TST()
  FormatRange (ActiveSheet.Range("A1"))
End Sub

Упорно работает (подставлял byRef и byVal).

bwbams

да, вы правы.
скорее всего ошибка в книге просто нет листа "Отчёт"
надо бы просто сделать проверку

on error resume next
Set ws = Worksheets("Отчёт")
if err.Number <> 0 then
.....
endif
...

on error goto 0

G

Ну вот

+ рад, что кто-то еще на форуме обработкой ошибок занимается

Вопрос по VBA Excel

Кто сейчас на конференции