Немного сократить код.

DsA

Гость

13.05.2010 13:11:38

Добрый день!
Помогите кто может, и если вообще можно. Записал макрорекордером, можно этот же код сократить до нормальных размеров. В идеале сделать так что бы при последующих нажатиях на кнопку делал то же самое, но на строку дальше т.е. сейчас строка 31, далее 32, далее 33 ну и т.д. Но это в идеале...
Sub М2() ' Добавляет первую строчку
Application.ScreenUpdating = False
Rows("31:31").Select
Selection.Insert Shift:=xlDown
Range("B31:R31").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("C31:F31").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("G31:K31").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("N31:O31").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("P31:R31").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("P31:R31").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("B32:R32").Select
Range("P31:R31,N31:R31,L31:M31,G31:K31,C31:K31,B31").Select
Range("B31").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A31").Select
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
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Rows("33:33").RowHeight = 18.75
ActiveWindow.SmallScroll Down:=-57
Range("W2").Select
Application.ScreenUpdating = True
End Sub

webley

Пользователь

Сообщений: 2176 Регистрация: 01.01.1970

13.05.2010 14:14:55

Вроде ничего не пропустил:
Sub Ì2()
i = 31
Rows(i).Insert Shift:=xlDown
Range("C" & i & ":F" & i).Merge
Range("G" & i & ":K" & i).Merge
Range("N" & i & ":O" & i).Merge
Range("P" & i & ":R" & i).Merge

With Range("B" & i & ":R" & i)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlInsideVertical).Weight = xlMedium
End With
End Sub

Что касается "в идеале" - номер строки задается через переменную i, смену строк можно реализовать через изменение этой переменной

webley Пользователь Сообщений: 2176 Регистрация: 01.01.1970	#3 13.05.2010 14:17:26 Название макроса при вставке потерялось - надо исправить: Sub Nazvanie()

DsA Гость	#4 13.05.2010 15:58:18 Большое спасибо, то что надо! Суть чуть только подправил: Sub М2() ' Добавляет первую строчку Application.ScreenUpdating = False i = 31 Rows(i).Insert Shift:=xlDown Range("C" & i & ":F" & i).Merge Range("G" & i & ":K" & i).Merge Range("N" & i & ":O" & i).Merge Range("P" & i & ":R" & i).Merge With Range("B" & i & ":R" & i) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Borders(xlEdgeRight).Weight = xlThin .Borders(xlEdgeLeft).Weight = xlMedium .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).Weight = xlMedium .Borders(xlEdgeRight).Weight = xlMedium .Borders(xlInsideVertical).Weight = xlThin End With Application.ScreenUpdating = True End Sub

Читают тему