Привет, помогите пожалуйста разобраться!Как увеличить ширину столбца в visual basic в excel/
код странички, где его менять надо?
Private Sub Worksheet_Activate()
CommandBars("Cell").Enabled = True
ISCContextMenu
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If LastISCCol = 0 Or LastISCRow = 0 Then
getlastiscrecord
End If
menuISCDeleteX.Enabled = Target.Column > TC And LastISCCol > TC + 1
menuISCDeleteY.Enabled = Target.Row > TR And LastISCRow > TR + 1
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If LastISCCol = 0 Or LastISCRow = 0 Then
getlastiscrecord
End If
With Worksheets("Св-ва и категории")
If Target.Column = 3 And Target.Row = 4 Then
va = GetOnlyNumber(.Cells(4, 3))
If va <> "" And va > 0 And TR + va <> LastISCRow Then
ISC_ChangeY OldY:=LastISCRow, NewY:=va + TR
LastISCRow = va + TR
SC_TablesChanged
Else
.Cells(4, 3) = LastISCRow - TR
End If
Else
If Target.Column = 3 And Target.Row = 5 Then
va = GetOnlyNumber(.Cells(5, 3))
If va <> "" And va > 0 And va + TC <> LastISCCol Then
ISC_ChangeX OldX:=LastISCCol, NewX:=va + TC
LastISCCol = va + TC
SC_TablesChanged
Else
.Cells(5, 3) = LastISCCol - TC
End If
Else
If Target.Column = 2 Then
If Target.Count = 1 And Target.Row > TR And Target.Row <= LastISCRow Then
SC_TablesChanged
If Target.Formula <> "" Then
If (Target.Row > TR + 1 And Not .Range("B" & TR + 1 & ":B" & Target.Row - 1).Find(Target.Formula) Is Nothing) Or (Target.Row < LastISCRow And Not .Range("B" & Target.Row + 1 & ":B" & LastISCRow).Find(Target.Formula) Is Nothing) Then
If MsgBox(Prompt:="Свойство с именем """ & Target.Formula & """ было использовано. " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Переименовать?", _
Buttons:=vbQuestion Or vbYesNo, Title:="Св-ва и категории") = vbYes Then
Target.Formula = Target.Formula + "_1"
Else
Target.Formula = ""
End If 'MsgBox
End If '''
End If 'Target.Formula <> ""
End If 'Target.Count = 1 And Target.Row > TR And Target.Row <= LastISCRow
Else '--Target.Column >= 3
If Target.Column >= 3 Then
If Target.Count = 1 And Target.Row > TR And Target.Row <= LastISCRow Then
SC_TablesChanged
If Target.Formula <> "" Then
If (Target.Column > TC + 1 And Not .Range(.Cells(Target.Row, TC + 1), .Cells(Target.Row, Target.Column - 1)).Find(Target.Formula) Is Nothing) Or (Target.Column < LastISCCol And Not .Range(.Cells(Target.Row, Target.Column + 1), .Cells(Target.Row, LastISCCol)).Find(Target.Formula) Is Nothing) Then
If MsgBox(Prompt:="Качество """ & Target.Formula & """ свойства """ & .Cells(Target.Row, TC).Formula & """ было использовано. " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Переименовать?", _
Buttons:=vbQuestion Or vbYesNo, Title:="Св-ва и категории") = vbYes Then
Target.Formula = Target.Formula + "_1"
Else
Target.Formula = ""
End If 'MsgBox
End If '''
End If 'Target.Formula <> ""
End If 'Target.Count = 1 And Target.Row > TR And Target.Row <= LastISCRow
End If 'Target.Column >= 3
End If 'Target.Column = 2
End If 'Target.Column = 3 And Target.Row = 5
End If 'Target.Column = 3 And Target.Row = 4
End With
End Sub
Public Sub ISC_ChangeX(OldX As Integer, NewX As Integer)
With Worksheets("Св-ва и категории")
If OldX > NewX Then
.Unprotect
.Range(.Cells(TR, TC + 1), .Cells(TR, NewX)).UnMerge
.Range(.Cells(TR, NewX + 1), .Cells(LastISCRow, OldX)).Delete
'.Columns(.Columns(NewX + 1), .Columns(OldX)).Delete
If .Cells(TR, TC + 1) <> "Качество" Then
.Cells(TR, TC + 1) = "Качество"
End If
RangeOutlineBorder Rrange:=.Range(.Cells(TR, TC + 1), .Cells(TR, NewX)), wWidth:=xlThin, IsMerged:=False
.Range(.Cells(TR, TC + 1), .Cells(TR, NewX)).Merge
Worksheets("Св-ва и категории").Protect DrawingObjects:=True, Scenarios:=True
Else
If OldX < NewX Then
.Unprotect
.Range(.Cells(TR + 1, OldX), .Cells(LastISCRow, NewX)).Interior.Color = RGB(255, 255, 255)
.Range(.Cells(TR + 1, OldX), .Cells(LastISCRow, NewX)).Locked = False
With .Range(.Cells(TR, TC + 1), .Cells(TR, NewX))
.Merge
.Interior.Color = RGB(160, 160, 160)
End With
RangeOutlineBorder Rrange:=.Range(.Cells(TR, TC + 1), .Cells(TR, NewX)), wWidth:=xlThin, IsMerged:=False
RangeOutlineBorder Rrange:=.Range(.Cells(TR, OldX), .Cells(LastISCRow, NewX)), wWidth:=xlThin, IsMerged:=False
Worksheets("Св-ва и категории").Protect DrawingObjects:=True, Scenarios:=True
End If
End If
End With
End Sub
Public Sub ISC_ChangeY(OldY As Integer, NewY As Integer)
With Worksheets("Св-ва и категории")
If OldY > NewY Then
.Unprotect
.Rows(NewY + 1 & ":" & OldY).Delete
Worksheets("Св-ва и категории").Protect DrawingObjects:=True, Scenarios:=True
Else
If LastISCCol = 0 Then
getlastiscrecord
End If
If OldY < NewY Then
.Unprotect
With .Range(.Cells(OldY, TC), .Cells(NewY, LastISCCol))
.Interior.Color = RGB(255, 255, 255)
.Locked = False
End With
RangeOutlineBorder Rrange:=.Range(.Cells(OldY, TC), .Cells(NewY, LastISCCol)), wWidth:=xlThin, IsMerged:=False
.Protect DrawingObjects:=True, Scenarios:=True
End If
End If
End With
End Sub
