Maximus777
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Цитата:| Ага это мне и надо. вот только возможно что табличка будет расти по мере добавления клиентов. |
Значит, в функцию смещения строк, надо добавить отлов границ. У меня Офис 2003. То ли он не понимает ваш файл, то ли он у вас не на русском языке, вобщем выглядит вот так:
Ячейку, по которой предлагаю отлавливать низ таблички, я выделил. Хз чего там у вас в оригинале написано, но если этот текст не меняется, то вот вам и решение. В коде я написал EndTable. Замените его на свой текст.
Код: Public Sub Auto_Open() 'Назначаем горячие клавиши
Application.OnKey "+^{UP}", "RowUp" 'Shift+Ctrl+Вверх
Application.OnKey "+^{DOWN}", "RowDown" 'Shift+Ctrl+Вниз
End Sub
Sub Mov(r As Long, dr As Integer) 'Аргументы: Строка, Направление
r1 = r + 1 * dr
Dim tmp As Range
With Rows(r).Worksheet.UsedRange
Set tmp = .Rows(.Rows.Count).Offset(1).EntireRow
End With
Rows(r).EntireRow.Copy tmp
Rows(r1).Copy Rows(r)
tmp.Copy Rows(r1)
Rows(r).EntireRow.Copy
tmp.PasteSpecial xlPasteFormats
Rows(r1).Copy
Rows(r).PasteSpecial xlPasteFormats
tmp.Copy
Rows(r1).PasteSpecial xlPasteFormats
tmp.Delete
Call Link(Cells(r, 1), Cells(r, 1).Hyperlinks.Count)
Call Link(Cells(r1, 1), Cells(r1, 1).Hyperlinks.Count)
Rows(r1).Select
End Sub
Sub Link(r As Range, s As Variant) 'Аргументы: Ячейка, Стиль
With r.Font
If s = 0 Then
.ColorIndex = 0
.Underline = False
Else
.ColorIndex = 5
.Underline = True
End If
End With
End Sub
Sub RowUp()
If ActiveCell.Row > 4 Then Call Mov(ActiveCell.Row, -1)
End Sub
Sub RowDown()
For i = 4 To 100
If Cells(i, 1) = "EndTable" Then n = i - 1: Exit For
Next i
If ActiveCell.Row < n Then Call Mov(ActiveCell.Row, 1)
End Sub |
|
но думаю долго не придется ждать.
: 
а попробуйте у себя открыть