Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL / 4 сообщений из 4, страница 1 из 1
04.02.2005, 15:45:57
    #32901734
GUEST_3
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL
Как передать процедуре диапазон ячеек
и как им воспользоваться ?

Обращение к процедуре имеет вид:

Код: plaintext
1.
2.
Dim m_Range As Range
m_Range = Range("C47:F56")
Call Abolition_Frames_2(m_Range)

Ниже приведен код процедуры,
снимающий линии – БОРДЮРЫ вокруг ячеек
(обрамление, если так можно назвать)

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
Private Sub Abolition_Frames_2(m_Range As Range)
'+  Range("C47:F55").Select ' так работает !
Range(m_Range).Select '  а так НЕ РАБОТАЕТ
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C56").Select 
End Sub

СПАСИБО
...
Рейтинг: 0 / 0
04.02.2005, 15:51:16
    #32901749
JRM
JRM
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL
А разве так не будет работать:
Код: plaintext
1.
2.
3.
'+  Range("C47:F55").Select ' так работает !
'- Range(m_Range).Select '  а так НЕ РАБОТАЕТ
m_Range.Select
...
Рейтинг: 0 / 0
04.02.2005, 15:53:34
    #32901755
marvan
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL
Sub f1()
Dim m_Range As Range
Set m_Range = ActiveSheet.Range("A2:C4")
Call Abolition_Frames_2(m_Range)
End Sub


Private Sub Abolition_Frames_2(m_Range As Range)
With m_Range
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub
...
Рейтинг: 0 / 0
08.02.2005, 11:56:54
    #32905683
LKO
LKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL
Я для обрамления ячеек написал процедуру и 2 перечисления :
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
Public Enum XBorderWeight
    xDefault = - 1 
    xNone = - 4142 
    xHairline =  1 
    xMedium = - 4138 
    xThick =  4 
    xThin =  2 
End Enum
Public Enum XBorderPosition
    xEdgeLeft =  7 
    xEdgeTop =  8 
    xEdgeBottom =  9 
    xEdgeRight =  10 
    xInsideVertical =  11 
    xInsideHorizontal =  12 
End Enum

Public Sub Bord(ByVal rng As Excel.Range, _
                Optional ByVal linStyle As Excel.XlLineStyle = xlContinuous, _
                Optional ByVal el As XBorderWeight = xDefault, _
                Optional ByVal et As XBorderWeight = xDefault, _
                Optional ByVal eb As XBorderWeight = xDefault, _
                Optional ByVal er As XBorderWeight = xDefault, _
                Optional ByVal iv As XBorderWeight = xDefault, _
                Optional ByVal ih As XBorderWeight = xDefault)

    Dim vTmpArea As Excel.Range
On Error GoTo ErrH
    
    If Not rng Is Nothing Then
        With rng
            For Each vTmpArea In .Areas
                With vTmpArea
                    If el <> xDefault Then
                        With .Borders(xEdgeLeft)
                            If el = xNone Then
                                .LineStyle = xlNone
                            Else
                                .LineStyle = linStyle
                                .Weight = el
                                .ColorIndex = xlAutomatic
                            End If
                        End With
                    End If
                    If et <> xDefault Then
                        With .Borders(xEdgeTop)
                            If et = xNone Then
                                .LineStyle = xlNone
                            Else
                                .LineStyle = linStyle
                                .Weight = et
                                .ColorIndex = xlAutomatic
                            End If
                        End With
                    End If
                    If eb <> xDefault Then
                        With .Borders(xEdgeBottom)
                            If eb = xNone Then
                                .LineStyle = xlNone
                            Else
                                .LineStyle = linStyle
                                .Weight = eb
                                .ColorIndex = xlAutomatic
                            End If
                        End With
                    End If
                    If er <> xDefault Then
                        With .Borders(xEdgeRight)
                            If er = xNone Then
                                .LineStyle = xlNone
                            Else
                                .LineStyle = linStyle
                                .Weight = er
                                .ColorIndex = xlAutomatic
                            End If
                        End With
                    End If
                    If iv <> xDefault Then
                        If .Columns.Count >  1  Then
                            With .Borders(xInsideVertical)
                                If iv = xNone Then
                                    .LineStyle = xlNone
                                Else
                                    .LineStyle = linStyle
                                    .Weight = iv
                                    .ColorIndex = xlAutomatic
                                End If
                            End With
                        End If
                    End If
                    If ih <> xDefault Then
                        If .Rows.Count >  1  Then
                            With .Borders(xInsideHorizontal)
                                If ih = xNone Then
                                    .LineStyle = xlNone
                                Else
                                    .LineStyle = linStyle
                                    .Weight = ih
                                    .ColorIndex = xlAutomatic
                                End If
                            End With
                        End If
                    End If
                End With
            Next vTmpArea
        End With
    End If
Exit Sub
ErrH:
    Err.Raise Err.Number, "Bord", Err.Description
End Sub

Есть небольшие ограничения, но для большинства задач хватает. Удобно использовать, если в программе много раз приходится обрамлять различные диапазоны.

Пример использования в VBA Office 2000 :

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub SomeSub()
    Dim rng As Excel.Range
On Error GoTo ErrH
    Set rng = ActiveSheet.Range("A1:B20,D10:G24")
    Bord rng, xlContinuous, xMedium, xMedium, xMedium, xMedium, xThin, xHairline
Exit Sub
ErrH:
    MsgBox Err.Description, vbCritical, Err.Source
End Sub

З.Ы.: Если использовать в VBA, то работает в Office 2000 и далее... (97-й не поддерживает перечислений)
Можно использовать и в VB, используя раннее связывание
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / ПЕРЕДАЧА ПАРАМЕТРОВ ПРОЦЕДУРЕ EXCEL / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]