Как в пределах создного диапозона, сделать границы для трех идущих подряд ячеек

@Don Vito · Регистрация: 22.11.2009

Author24 — интернет-сервис помощи студентам

Всем привет!

У меня два вопроса, как в пределах создного диапозона(обращаясь к ним через диапозон), сделать для трех идущих подряд ячеек границы?

Как их объеденить?

Заранее спасибо!

Dragokas · 10.02.2012, 16:24

Visual Basic

Sub aa()
With [B2].Range(Cells(1, 1), Cells(1, 3)).Borders '1,1 как стартовая позиция, относительно B2
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
End Sub
 
Sub bb()
[B2].Range(Cells(1, 1), Cells(1, 3)).Merge
End Sub
 
'или по-вертикали Cells(1, 1), Cells(3, 1)

@Don Vito · 10.02.2012, 16:36 **[ТС]**

Если конкретней, то я начал изучать VBA и пытаюсь написать простенькую програмку, которая выводит на листе Excel надпись введенную пользователем. Соответственно, подкаждую букву введенную пользователем я определяю диапозон значений. Но для некоторых букв, мне в нутри диапозона нужно создать еще один диапозон и например, выделить его другим цветом или типом линии.

Добавлено через 50 секунд

Сообщение от Diskretor

Visual Basic

Sub aa()
With [B2].Range(Cells(1, 1), Cells(1, 3)).Borders '1,1 как стартовая позиция, относительно B2
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
End Sub
 
Sub bb()
[B2].Range(Cells(1, 1), Cells(1, 3)).Merge
End Sub
 
'или по-вертикали Cells(1, 1), Cells(3, 1)

[B2] - это как раз первый диапозон,да?

@Don Vito · 10.02.2012, 17:09 **[ТС]**

все очень просто, пользователю предлагается ввести в InputBox() фразу, и программка рисует на листе Excel набранные буквы разноцветными квадратиками... Так как цель всего этого разобраться в VBA,то я создал пользовательский класс, в котором сосдается новый лист для всего в.у. и для каждой буквы алфавита прописывается процедура (внутри класса) которая рисует эту букву. Певрое что я делаю, это считаю кол-во букв, потом в цикле сравниваю каждую букву с буквой алфавита и если они совпадают Бум!)) вызываю соответствующую процедуру, которая рисует мне ее)) Рисовние происходит следующим образом, в процедуру передается вся строка и счетчик, процедура выделяет диапозон и работая внутри диапозона рисует ее... пфу.. вот))

Dragokas · 10.02.2012, 18:04

Сообщение от Diskretor

[B2].Range...

Да, B2 - это начальная ячейка.
Можно ее записать хоть Range("B2"), можно [B2:Q20], где например
Range("B2:Q20").Cells(3,2) будет означать позицию y=3, x=2 относительно стартовой ячейки B2.
При этом Q20 не играет никакой роли, значение x, y относительно B2 может превышать конечный Range.
Можно еще воспользоваться такой записью:

Visual Basic

1 2	Set Zone = Range("B2") Zone.Range("B2") = 3 'запись будет произведена в ячейку С3 (B2+B2)

Все это называется относительная адресация.

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

Сообщение от Don Vito

рисует...буквы...квадратиками

О_о

В общем немного понятно, но очень приблизительно. Если б еще и картинку того, того что должно получится.

@Don Vito · 10.02.2012, 18:18 **[ТС]**

Сообщение от Diskretor

Visual Basic

Sub aa()
With [B2].Range(Cells(1, 1), Cells(1, 3)).Borders '1,1 как стартовая позиция, относительно B2
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
End Sub
 
Sub bb()
[B2].Range(Cells(1, 1), Cells(1, 3)).Merge
End Sub
 
'или по-вертикали Cells(1, 1), Cells(3, 1)

Сделал вот так:

Visual Basic

With [Äèàïîçîí].Range(Cells(1, 1), Cells(5, 1)).Borders
 
.LineStyle = xlContinuous
.Weight = xlMidle
 
End With

выдает ошибку

"нельзя установить свойствой Weight для класса Boarders"

Добавлено через 4 минуты

Сообщение от Diskretor

Да, B2 - это начальная ячейка.
Можно ее записать хоть Range("B2"), можно [B2:Q20], где например
Range("B2:Q20").Cells(3,2) будет означать позицию y=3, x=2 относительно стартовой ячейки B2.
При этом Q20 не играет никакой роли, значение x, y относительно B2 может превышать конечный Range.
Можно еще воспользоваться такой записью:

Visual Basic

1 2	Set Zone = Range("B2") Zone.Range("B2") = 3 'запись будет произведена в ячейку С3 (B2+B2)

Все это называется относительная адресация.

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

О_о

В общем немного понятно, но очень приблизительно. Если б еще и картинку того, того что должно получится.

Visual Basic

Dim My_Phrase As Object
 
Sub Alph()
 
Set My_Phrase = New Alphavit
 
End Sub

класс:

Visual Basic

Dim Fun_Alphavit As Worksheet
Dim Sentence As String
Dim ln As Integer
 
 
Private Sub Class_Initialize()
 
 
Dim sh_count As Integer
 
Set Fun_Alphavit = Worksheets.Add
 
Fun_Alphavit.Name = "Ñìåøíîé Àëôàâèò"
 
'Sentence = InputBox("Ââåäèòå ôðàçó:", "Ñìåøíîé Àëôàâèò")
 
'ln = Len(Sentence)
 
Worksheets.Item("Ñìåøíîé Àëôàâèò").Cells.Interior.ColorIndex = 6
 
Call À(Sentence, 1)
 
Call Á(Sentence, 2)
 
For i = 1 To ln
    
    'If Mid(Sentence, i, 1) Like "À" Then Call À(Sentence, i)
        If Mid(Sentence, i, 1) Like "Á" Then
           Call Á(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Â" Then
           Call Â(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ã" Then
           Call Ã(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ä" Then
           Call Ä(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Å" Then
           Call Å(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Æ" Then
           Call Æ(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ç" Then
           Call Ç(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "È" Then
            Call È(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ê" Then
            Call Ê(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ë" Then
            Call Ë(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ì" Then
            Call Ì(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Í" Then
            Call Í(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Î" Then
           Call Î(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ï" Then
           Call Ï(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ð" Then
           Call Ð(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ñ" Then
           Call Ñ(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ò" Then
           Call Ò(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ó" Then
           Call Ó(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ô" Then
           Call Ô(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Õ" Then
           Call Õ(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ö" Then
           Call Ö(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "×" Then
           Call ×(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ø" Then
           Call Ø(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ù" Then
          Call Ù(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ú" Then
           Call Ú(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Û" Then
           Call Û(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ü" Then
           Call Ü(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Ý" Then
           Call Ý(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "Þ" Then
           Call Þ(Sentence, i)
        ElseIf Mid(Sentence, i, 1) Like "ß" Then
           Call ß(Sentence, i)
        End If
        
Next i
 
 
End Sub
 
 
 
Sub À(D As String, b As Integer)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(5, Edn)).Name = "Äèàïîçîí"
 
[Äèàïîçîí].Cells.Interior.ColorIndex = 10
[Äèàïîçîí].Cells(5, 1).Interior.ColorIndex = 3
[Äèàïîçîí].Cells(5, 1).BorderAround Weight:=xlMedium
 
 
 
[Äèàïîçîí].Cells(3, 2).Interior.ColorIndex = 3
 
[Äèàïîçîí].Cells(3, 3).Interior.ColorIndex = 3
 
[Äèàïîçîí].Cells(3, 4).Interior.ColorIndex = 3
 
[Äèàïîçîí].Range(Cells(3, 2), Cells(3, 4)).Merge
 
[Äèàïîçîí].Range(Cells(3, 2), Cells(3, 4)).BorderAround Weight:=xlMedium
 
 
 
 
[Äèàïîçîí].Cells(1, 3).Interior.ColorIndex = 3
[Äèàïîçîí].Cells(1, 3).BorderAround Weight:=xlMedium
 
[Äèàïîçîí].Cells(5, 5).Interior.ColorIndex = 3
[Äèàïîçîí].Cells(5, 5).BorderAround Weight:=xlMedium
 
 
End Sub
 
Sub Á(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(5, Edn)).Name = "Äèàïîçîí"
 
[Äèàïîçîí].Cells.Interior.ColorIndex = 10
 
With [Äèàïîçîí].Range(Cells(1, 1), Cells(5, 1)).Borders
 
.LineStyle = xlContinuous
.Weight = xlMidle
 
End With
 
 
End Sub
 
Sub Â(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ã(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ä(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Å(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Æ(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ç(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub È(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ê(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ë(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ì(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Í(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Î(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ï(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ð(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ñ(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ò(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ó(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ô(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Õ(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ö(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub ×(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ø(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ù(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ú(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Û(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ü(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Ý(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Þ(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub ß(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Sub Space(D As String, b As Variant)
 
Dim Start, Edn As Integer
 
Start = (b - 1) * 6 + 1
Edn = Start + 5
 
Worksheets("Ñìåøíîé Àëôàâèò").Range(Worksheets("Ñìåøíîé Àëôàâèò").Cells(1, Start), Worksheets("Ñìåøíîé Àëôàâèò").Cells(6, Edn)).Name = "Äèàïîçîí"
 
End Sub
 
Function Diap(N, X, Y As Integer)
 
Diap = Range("Y:X").Select
 
 
End Function
 
Private Sub Class_Terminate()
 
End Sub

Вообщем, это пока учебный набросок, без комментариев и т.д.

@аналитика · 10.02.2012, 18:49

посмотри книгу

@Don Vito · 10.02.2012, 19:17 **[ТС]**

ошибка, type mismatch, у Вас на машине работает?

Dragokas · 10.02.2012, 20:15

Да в 2003 все нормально, а в 2007 непонятно почему Code 13 type mismatch на строке:

Visual Basic

1	Columns("A:XX").Delete

попробуйте поменять ее на:

Visual Basic

1	Cells.Clear

@аналитика · 10.02.2012, 20:19

замени процедуры

Visual Basic

Sub sssss()
    Columns("A:CC").Delete '<=================== эту строчку поменял, в 2003 XL нет столько столбцов
    
    Dim s As String: s = "АБВГВГБАВАБ"
    DrawWord s, Cells(1, 1)
End Sub
 
Sub DrawWord(s As String, rng As Range)
    Dim i As Integer
    On Error Resume Next
    For i = 1 To Len(s)
        DrawLetter GetArrLett(Mid(s, i, 1)), _
                   rng.Offset(, 6 * (i - 1))
        DoEvents                '<=================== эту строчку добавил, чтоб не зависало
    Next i
End Sub

@Don Vito · 10.02.2012, 21:03 **[ТС]**

Блин, у меня опять -

Compile error, can't find project or library

Нужно же было две строчки поменять, да?

Добавлено через 42 секунды
синим цветом выделяет mid()

@аналитика · 10.02.2012, 21:17

tools - referencies - там все missing'и долой (аутлук наверно прицепился)

Dragokas · 10.02.2012, 21:24

Сообщение от Don Vito

синим цветом выделяет mid()

Что и у Вас тоже? - а то я думал криво поставил паралельно 2003 + 2007.

Решил так:
1) ALT+F11, сделал действие аналитика.
2) В том же окне - Browse, "c:\Program Files (x86)\Microsoft Office\Office12\", выбрать файл msoutl.olb. Библиотека появится у Вас в списке. Поставьте на нее галочку.
Только после этого прекратилось.

@аналитика · 10.02.2012, 21:55

Сообщение от Diskretor

2) В том же окне - Browse, "c:\Program Files (x86)\Microsoft Office\Office12\", выбрать файл msoutl.olb. Библиотека появится у Вас в списке. Поставьте на нее галочку.

эта библиотека там на ... не нужна

Сообщение от Diskretor

Только после этого прекратилось.

закрутилось ты имел, наверное, ввиду

@Don Vito · 10.02.2012, 22:22 **[ТС]**

ну вот...

всякий интерес пропал делать это дальше(((

в чем фишка, не могу понять, что именно рисует-то?

Dragokas · 10.02.2012, 22:48

Сообщение от аналитика

закрутилось ты имел, наверное, ввиду

Нет. Прекратило выдавать ошибку. А то я думал что Excel VBA уже свои родные команды (mid) не понимает О_о - библиотеку ему ишь подавай.

Сообщение от аналитика

эта библиотека там на ... не нужна

Да я то понял.
Но когда я снял галку с Missing библиотеки, сохранял, закрывал/открывал документ, то пока не ткнул носом Excel в тот файл msoutl.olb, оно так мне и продолжало писать - "Не выполню MID пока не дашь библиотеку!"

@аналитика · 10.02.2012, 22:50

Сообщение от Don Vito

в чем фишка, не могу понять, что именно рисует-то?

здрасти, приехали...

там есть скрытый лист с "трафаретами" букв - именованные области ("А_", "Б_",..)
чтобы "нарисовать" букву процедуре нужна ячейка (верхняя левая ячейка "рисунка") и "карта" буквы (2-мерный массив "да/нет" - "черное/белое"), которую она и считывает со скрытого листа (можно перебить в массив "1/0") ...

@Don Vito · 10.02.2012, 23:08 **[ТС]**

Сообщение от аналитика

здрасти, приехали...

там есть скрытый лист с "трафаретами" букв - именованные области ("А_", "Б_",..)
чтобы "нарисовать" букву процедуре нужна ячейка (верхняя левая ячейка "рисунка") и "карта" буквы (2-мерный массив "да/нет" - "черное/белое"), которую она и считывает со скрытого листа (можно перебить в массив "1/0") ...

это реально круто...

нет, правда, супперр!))

Dragokas · 11.02.2012, 03:19

Сообщение от Don Vito

всякий интерес пропал делать это дальше(((

Ну почему же. Всегда есть куда стремиться:

1) Вернуться к Вашей первоначальной задумке:
нажимаешь клавишу, а он печатает большую.
2) Убрать эффект печатной машинки, это будет очень сложно (морально).
3) Добавить весь алфавит.
4) Убрать именованные диапазоны, оптимизировав код так:

Visual Basic

Function GetArrLett(s As String)
Dim POS As Range
...
Set POS = Sheets(1).Cells(8, 2 + (Asc(s) - 192) * 6)
arr(r, c) = (Range(POS, POS.Offset(-6, 4)).Cells(r, c).Interior.Color = vbBlack)

Теперь просто рисуем трафареты дальше.

Сообщение от Don Vito

в чем фишка, не могу понять, что именно рисует-то?

Я тоже не найдя команды Sheets, подумал, что волшебство

Не по теме:

Первое пришло в голову, что читает из файлов Windows\Fonts
Потом, долго думал, что за формат такой записи диапазона "S_" O_o

@Don Vito · 11.02.2012, 18:38 **[ТС]**

Я тоже подуал, что может быть есть функция (в какой нибудь библиотеке XL ), которая в себе содержит какой-то графический код алфавита... Идея с трафаретами - это, признаться фокус, а без разгадки - магия)))

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

Добавлено через 4 часа 33 минуты
В продолжение темы, а где можно посмотреть свойства объектов XL и их функции?

Может, где-то есть иерархия объектов?

@аналитика здесь больше нет... 3374 / 1672 / 184 Регистрация: 03.02.2010 Сообщений: 1,219
	10.02.2012, 21:55	14
	Сообщение от Diskretor 2) В том же окне - Browse, "c:\Program Files (x86)\Microsoft Office\Office12\", выбрать файл msoutl.olb. Библиотека появится у Вас в списке. Поставьте на нее галочку. эта библиотека там на ... не нужна Сообщение от Diskretor Только после этого прекратилось. закрутилось ты имел, наверное, ввиду 1

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
		1
	Как в пределах создного диапозона, сделать границы для трех идущих подряд ячеек 10.02.2012, 16:10. Показов 2956. Ответов 26 Метки нет (Все метки) Всем привет! У меня два вопроса, как в пределах создного диапозона(обращаясь к ним через диапозон), сделать для трех идущих подряд ячеек границы? Как их объеденить? Заранее спасибо! 0

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	10.02.2012, 17:09 [ТС]	4
	все очень просто, пользователю предлагается ввести в InputBox() фразу, и программка рисует на листе Excel набранные буквы разноцветными квадратиками... Так как цель всего этого разобраться в VBA,то я создал пользовательский класс, в котором сосдается новый лист для всего в.у. и для каждой буквы алфавита прописывается процедура (внутри класса) которая рисует эту букву. Певрое что я делаю, это считаю кол-во букв, потом в цикле сравниваю каждую букву с буквой алфавита и если они совпадают Бум!)) вызываю соответствующую процедуру, которая рисует мне ее)) Рисовние происходит следующим образом, в процедуру передается вся строка и счетчик, процедура выделяет диапозон и работая внутри диапозона рисует ее... пфу.. вот)) 0

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	10.02.2012, 19:17 [ТС]	8
	ошибка, type mismatch, у Вас на машине работает? 0

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	10.02.2012, 21:03 [ТС]	11
	Блин, у меня опять - Compile error, can't find project or library Нужно же было две строчки поменять, да? Добавлено через 42 секунды синим цветом выделяет mid() 0

@аналитика здесь больше нет... 3374 / 1672 / 184 Регистрация: 03.02.2010 Сообщений: 1,219
	10.02.2012, 21:17	12
	tools - referencies - там все missing'и долой (аутлук наверно прицепился) 1

Dragokas 17996 / 7697 / 892 Регистрация: 25.12.2011 Сообщений: 11,470 Записей в блоге: 16
	10.02.2012, 21:24	13
	Сообщение от Don Vito синим цветом выделяет mid() Что и у Вас тоже? - а то я думал криво поставил паралельно 2003 + 2007. Решил так: 1) ALT+F11, сделал действие аналитика. 2) В том же окне - Browse, "c:\Program Files (x86)\Microsoft Office\Office12\", выбрать файл msoutl.olb. Библиотека появится у Вас в списке. Поставьте на нее галочку. Только после этого прекратилось. 2

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	10.02.2012, 22:22 [ТС]	15
	ну вот... всякий интерес пропал делать это дальше((( в чем фишка, не могу понять, что именно рисует-то? 0

Dragokas 17996 / 7697 / 892 Регистрация: 25.12.2011 Сообщений: 11,470 Записей в блоге: 16
	10.02.2012, 22:48	16
	Сообщение от аналитика закрутилось ты имел, наверное, ввиду Нет. Прекратило выдавать ошибку. А то я думал что Excel VBA уже свои родные команды (mid) не понимает О_о - библиотеку ему ишь подавай. Сообщение от аналитика эта библиотека там на ... не нужна Да я то понял. Но когда я снял галку с Missing библиотеки, сохранял, закрывал/открывал документ, то пока не ткнул носом Excel в тот файл msoutl.olb, оно так мне и продолжало писать - "Не выполню MID пока не дашь библиотеку!" 1

@аналитика здесь больше нет... 3374 / 1672 / 184 Регистрация: 03.02.2010 Сообщений: 1,219
	10.02.2012, 22:50	17
	Сообщение от Don Vito в чем фишка, не могу понять, что именно рисует-то? здрасти, приехали... там есть скрытый лист с "трафаретами" букв - именованные области ("А_", "Б_",..) чтобы "нарисовать" букву процедуре нужна ячейка (верхняя левая ячейка "рисунка") и "карта" буквы (2-мерный массив "да/нет" - "черное/белое"), которую она и считывает со скрытого листа (можно перебить в массив "1/0") ... 2

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	10.02.2012, 23:08 [ТС]	18
	Сообщение от аналитика здрасти, приехали... там есть скрытый лист с "трафаретами" букв - именованные области ("А_", "Б_",..) чтобы "нарисовать" букву процедуре нужна ячейка (верхняя левая ячейка "рисунка") и "карта" буквы (2-мерный массив "да/нет" - "черное/белое"), которую она и считывает со скрытого листа (можно перебить в массив "1/0") ... это реально круто... нет, правда, супперр!)) 1

@Don Vito 9 / 9 / 1 Регистрация: 22.11.2009 Сообщений: 174
	11.02.2012, 18:38 [ТС]	20
	Я тоже подуал, что может быть есть функция (в какой нибудь библиотеке XL ), которая в себе содержит какой-то графический код алфавита... Идея с трафаретами - это, признаться фокус, а без разгадки - магия))) Я буду пытаться реализовать свою идею, т.е. в каждой функции буквы, будет зашито графическая реализация, а потом сделаю, то ччто Вы сказали... Добавлено через 4 часа 33 минуты В продолжение темы, а где можно посмотреть свойства объектов XL и их функции? Может, где-то есть иерархия объектов? 1