powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / авто
1 сообщений из 1, страница 1 из 1
авто
    #33994226
scouti8
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Private Sub CboGod_Change()
FrmModel.CmdOk.Default = True
FrmModel.CmdCancel.Cancel = True
FrmModel.TextMin.Value = 0
FrmModel.TextMax.Value = 0



god = CboGod.Text
file = "C:\Íàëè÷èå\Àâòîìîáèëè-" & god & ".xls"
FrmModel.LstMarka.Clear
Num = 0


' ************Ïðîâåðêà íà ñóøåñòâîâàíèå ôàéëà ñ òåìàìè


If Dir(file) = "" Then
MsgBox ("Ôàéë Áä Àâòîìîáèëè-" & god & ".xls íå ñóùåñòâóåò!")
Exit Sub
End If
fil = Right(file, 19)
Dim FOpen As Boolean
For Each Êíèãà In Workbooks
If Êíèãà.Name = fil Then
FOpen = True
Workbooks(Êíèãà.Name).Activate
Worksheets("Ëèñò1").Select
Exit For
End If
Next Êíèãà


If FOpen = False Then
Workbooks.Open file
Worksheets("Ëèñò1").Select
End If

' ********** Çàíîñèì òåìû â ìàññèâ

Dim NomerStrok As Integer

Dim flag As Boolean


NomerStrok = 2
kolMarok = 1


Do While Trim(Cells(NomerStrok, 1).Value) <> ""
flag = False

If flag = False Then
ReDim Preserve Marki(kolMarok)
Marki(kolMarok) = Trim(Cells(NomerStrok, 1).Value)
kolMarok = kolMarok + 1

End If

NomerStrok = NomerStrok + 1
Loop

'************ Ñîðòèðóåì òåìû ïî àëôàâèòó


For i = 1 To kolMarok - 1
For j = 1 To kolMarok - 2
If Marki(j) > Marki(j + 1) Then
pervui = Marki(j)
Marki(j) = Marki(j + 1)
Marki(j + 1) = pervui
End If
Next j
Next i
kol = 1

For i = 1 To kolMarok - 1

If Marki(i - 1) <> Marki(i) Then
ReDim Preserve Marka(kol)
Marka(0) = "ÂÑÅ"
Marka(kol) = Marki(i)
kol = kol + 1
End If
Next i

'**************Âûâîäè òåìû â lst ëèñò

FrmModel.LstMarka.List = Marka

End Sub

Private Sub CmdCancel_Click()

god = CboGod.Text
file = "C:\Íàëè÷èå\Àâòîìîáèëè-" & god & ".xls"

fil = Right(file, 19)
For Each book In Workbooks
If book.Name = fil Then
Workbooks(book.Name).Close saveChanges = False
Exit For
End If
Next

Unload FrmModel
End Sub

Private Sub CmdOk_Click()
Dim bubmark1 As Boolean
Min = SpinBMin.Value
Max = SpinBMax.Value
For i = 0 To LstMarka.ListCount - 1
If FrmModel.LstMarka.Selected(i) = True Then
bubmark1 = True
End If
Next i

If bubmark1 = False Then
MsgBox ("Íå âûáðàíà ÌÀÐÊÀ!")
Exit Sub
End If
If (optbDollar Or optbEvro) = False Then
MsgBox ("Íå âûáðàíà ÂÀËÞÒÀ!")
Exit Sub
End If

Path = "C:\Íàëè÷èå\" & Date & ""
If Dir(Path, vbDirectory) = "" Then

'Ñîçäàíèå ïàïêè,` åñëè å¸ íåò

MkDir (Path)
End If
If optbDollar = True Then
file = " " & Min & "$-" & Max & "$.xls"
End If
If optbEvro = True Then
file = " " & Min & "ˆ-" & Max & "ˆ.xls"
End If

If Dir(Path & "\" & file) = "" Then

' Ñîçäàíèå ôàéëà, åñëè åãî íåò

Workbooks.Add.SaveAs (Path & "\" & file)
nach = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1


Workbooks(Workbooks.Count).Worksheets(1).Name = "ÑÏÈÑÎÊ"
Application.SheetsInNewWorkbook = nach

Else
For Each book In Workbooks
If book.Name = file Then
book.Close saveChanges:=True
End If
Next
ñîîáøåíèå = "Ôàéë " & file & " óæå ñóùåñòâóåò. Çàìåíèòü åãî?"
îòâåò = MsgBox(ñîîáøåíèå, vbInformation + vbOKCancel, "Âíèìàíèå")
Select Case îòâåò
Case vbOK
Kill (Path & "\" & file)

Workbooks.Add.SaveAs (Path & "\" & file)

Workbooks.Open (Path & "\" & file)
nach = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks(Workbooks.Count).Worksheets(1).Name = "ÑÏÈÑÎÊ"
Application.SheetsInNewWorkbook = nach

Case vbCancel
Exit Sub
End Select


End If
Call ramka(stroke)
Call sortirovka
Unload FrmModel
Workbooks(file).save
Workbooks("Àâòîìîáèëè-" & CboGod.Text & ".xls").Close saveChanges = False
sms = MsgBox("Ñïèñîê ÌÎÄÅËÅÉ ñôîðìèðîâàí!", vbInformation, "Âíèìàíèå")

End Sub


Sub sortirovka()
'*********Çàíîñèì ìàðêè âûáðàííûå â ìàññèâ *********
Dim bubmark1 As Boolean
Dim bubmark2 As Boolean
Dim flag2 As Boolean
Dim dengi3 As Long
Min = SpinBMin.Value
Max = SpinBMax.Value

If optbDollar = True Then
file1 = " " & Min & "$-" & Max & "$.xls"
End If
If optbEvro = True Then
file1 = " " & Min & "ˆ-" & Max & "ˆ.xls"
End If


If FrmModel.LstMarka.Selected(0) = True Then
bubmark2 = True
End If
god = CboGod.Text
file = "C:\Íàëè÷èå\Àâòîìîáèëè-" & god & ".xls"



If Dir(file) = "" Then
MsgBox ("Ôàéë áä Àâòîìîáèëè-" & god & ".xls íå ñóùåñòâóåò!")

FrmModel.LstMarka.Clear
Exit Sub
End If

fil = Right(file, 19)
Dim FOpen As Boolean
For Each Êíèãà In Workbooks
If Êíèãà.Name = fil Then
FOpen = True
Workbooks(Êíèãà.Name).Activate
Worksheets("Ëèñò1").Select
Exit For
End If
Next Êíèãà


If FOpen = False Then
Workbooks.Open file
Worksheets("Ëèñò1").Select
End If
'*****************åñëè âûáèðàåì ìàðêè îòäåëüíî ************
If bubmark2 = False Then

For i = 1 To LstMarka.ListCount - 1

If FrmModel.LstMarka.Selected(i) = True Then
bubmark1 = True



ReDim Preserve bubmark(KolBubmarok)
bubmark(KolBubmarok) = Marka(i)
KolBubmarok = KolBubmarok + 1


End If
Next i


NomerStroki = 2
kolMar = 1

dengaMin = SpinBMin.Value
dengaMax = SpinBMax.Value
strok = 0
Do While Trim(Cells(NomerStroki, 1).Value) <> ""
flag = False
If flag = False Then
ReDim Preserve Marku(kolMar)
Marku(kolMar) = Trim(Cells(NomerStroki, 1).Value)


End If
i = 0


For i = 0 To KolBubmarok - 1

If Marku(kolMar) = bubmark(i) Then
valute = Trim(Cells(NomerStroki, 3).Value)
valuta = Right(valute, 1)
dengi = Trim(Cells(NomerStroki, 3).Value)
dangi1 = Right(dengi, 8)


dengi2 = Left(dangi1, 6)
S = ""
n = Len(dengi)

For j = 1 To n

If Mid(dengi2, j, 1) <> " " Then
S = S + Mid(dengi2, j, 1)
End If
dengi3 = 0
Next j
If S <> "" Then
dengi3 = Mid(S, 1, 5)
End If

ReDim Preserve KonMarka(19, strok)

'*********************ïðîâåðêà äåíåæíîé âàëþòû******
If optbDollar = True Then
If valuta = "$" Then
If n > 9 Then
flag2 = True
Else:
flag2 = False
End If
If flag2 = True Then
If dengi3 <= dengaMax Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)

Next stolb
strok = strok + 1
End If
End If

If flag2 = False Then
If dengi3 < dengaMax And dengi3 > dengaMin Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)
Range("A2").Select
Next stolb
strok = strok + 1
End If
End If
End If
End If
If optbEvro = True Then
If valuta = "ˆ" Then
If n > 9 Then
flag2 = True
Else:
flag2 = False

End If
If flag2 = True Then
If dengi3 <= dengaMax Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)
Range("A2").Select
Next stolb
strok = strok + 1
End If
End If
If flag2 = False Then
If dengi3 < dengaMax And dengi3 > dengaMin Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value

stroke = strok + 4

Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)

Next stolb
strok = strok + 1
End If
End If
End If
End If


End If
Next

kolMar = kolMar + 1
NomerStroki = NomerStroki + 1

Loop
End If
'*************** Åñëè ÂÑÅ ***************
If bubmark2 = True Then

For i = 1 To LstMarka.ListCount - 1
FrmModel.LstMarka.Selected(i) = True
ReDim Preserve bubmark(KolBubmarok)
bubmark(KolBubmarok) = Marka(i)
KolBubmarok = KolBubmarok + 1
Next i


NomerStroki = 2
kolMar = 1

dengaMin = SpinBMin.Value
dengaMax = SpinBMax.Value
strok = 0
Do While Trim(Cells(NomerStroki, 1).Value) <> ""
flag = False
If flag = False Then
ReDim Preserve Marku(kolMar)
Marku(kolMar) = Trim(Cells(NomerStroki, 1).Value)


End If
i = 0

For i = 0 To KolBubmarok - 1

If Marku(kolMar) = bubmark(i) Then
valute = Trim(Cells(NomerStroki, 3).Value)
valuta = Right(valute, 1)
dengi = Trim(Cells(NomerStroki, 3).Value)
dangi1 = Right(dengi, 8)


dengi2 = Left(dangi1, 6)
S = ""
n = Len(dengi)

For j = 1 To n

If Mid(dengi2, j, 1) <> " " Then
S = S + Mid(dengi2, j, 1)
End If
dengi3 = 0
Next j
If S <> "" Then
dengi3 = Mid(S, 1, 5)
End If


ReDim Preserve KonMarka(19, strok)

'*********************ïðîâåðêà äåíåæíîé âàëþòû******
If optbDollar = True Then
If valuta = "$" Then
If n > 9 Then
flag2 = True
Else:
flag2 = False

End If
If flag2 = True Then
If dengi3 <= dengaMax Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)
Range("A2").Select
Next stolb
strok = strok + 1
End If
End If
If flag2 = False Then
If dengi3 < dengaMax And dengi3 > dengaMin Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)
Range("A2").Select
Next stolb
strok = strok + 1
End If
End If
End If
End If
If optbEvro = True Then
If valuta = "ˆ" Then
If n > 9 Then
flag2 = True
Else:
flag2 = False

End If
If flag2 = True Then
If dengi3 <= dengaMax Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value
stroke = strok + 4
Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)
Range("A2").Select
Next stolb
strok = strok + 1
End If
End If
If flag2 = False Then
If dengi3 < dengaMax And dengi3 > dengaMin Then

For stolb = 1 To 19
KonMarka(19, strok) = Cells(NomerStroki, stolb).Value

stroke = strok + 4

Workbooks(file1).Sheets(1).Cells(stroke, stolb).Value = KonMarka(19, strok)

Next stolb
strok = strok + 1
End If
End If
End If
End If


End If
Next

kolMar = kolMar + 1
NomerStroki = NomerStroki + 1

Loop
End If

If (bubmark1 Or bubmark2) = False Then
MsgBox ("Íå âûáðàíà ÌÀÐÊÀ!")
Exit Sub
End If

End Sub
Sub ramka(stroke)
Min = SpinBMin.Value
Max = SpinBMax.Value
god = CboGod.Text
If optbDollar = True Then
file1 = " Àâòîìîáèëè ñòîèìîñòüþ îò " & Min & "$ äî " & Max & "$.xls"
End If
If optbEvro = True Then
file1 = "Àâòîìîáèëè ñòîèìîñòüþ îò " & Min & "ˆ äî " & Max & "ˆ.xls"
End If
Range("C1:R1").Select
ActiveCell.FormulaR1C1 = file1
With ActiveCell.Characters(Start:=1, Length:=60).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("E2", "P2").Select
ActiveCell.FormulaR1C1 = "Ãîä âûïóñêà" + god
With ActiveCell.Characters(Start:=1, Length:=18).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Range("A3").Select
ActiveCell.FormulaR1C1 = "Ìàðêà Àâòîìîáèëÿ"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Rows("3:3").Select
Selection.RowHeight = 90.75
Range("A3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").ColumnWidth = 15
Selection.Copy
Range("A3:E3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B3").Select
ActiveCell.FormulaR1C1 = "Ìîäåëü àâòîìîáèëÿ"
With ActiveCell.Characters(Start:=1, Length:=23).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C3").Select
Columns("C:C").ColumnWidth = 11.14
Columns("B:B").ColumnWidth = 11.43
Range("C3").Select
ActiveCell.FormulaR1C1 = "Öåíà"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D3").Select
ActiveCell.FormulaR1C1 = "Òèï êóçîâà äâåðåé/ìåñò"
With ActiveCell.Characters(Start:=1, Length:=22).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Cut Destination:=Range("E3")
Range("E3").Select
Selection.Cut Destination:=Range("D3")
Range("D3").Select
Columns("D:D").ColumnWidth = 10.43
Columns("D:D").ColumnWidth = 12
Range("E3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Ãîä âûïóñêà"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Öåíòð çàìîê"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Copy
Range("F3:S3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("G3").Select
ActiveCell.FormulaR1C1 = "Ïðîòèâîóãîí Ñèãíàë"
With ActiveCell.Characters(Start:=1, Length:=18).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("H3").Select
ActiveCell.FormulaR1C1 = "Èììîáèëàéçåð"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("I3").Select
ActiveCell.FormulaR1C1 = "Ãèäðîóñèëèòþðóëÿ"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("J3").Select
ActiveCell.FormulaR1C1 = "Ðåãóë. Ðóë. Êîëîíêà"
With ActiveCell.Characters(Start:=1, Length:=19).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("K3").Select
ActiveCell.FormulaR1C1 = "àâòîìàòè÷.ÊÏ"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L3").Select
ActiveCell.FormulaR1C1 = "Ýë.ïðèâîä çåðêàëà"
With ActiveCell.Characters(Start:=1, Length:=17).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("M3").Select
ActiveCell.FormulaR1C1 = "Ýë.ïðèâîä ñòåêîë"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("N3").Select
ActiveCell.FormulaR1C1 = "ýë.ïðèâîä êðåñåë"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("O3").Select
ActiveCell.FormulaR1C1 = "Ïîäîãðåâ çåðêàë"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("P3").Select
ActiveCell.FormulaR1C1 = "ïîäîãðåâ êðåñåë"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("Q3").Select
ActiveCell.FormulaR1C1 = "ïîäóøêè áåçîïàñíîñòè"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("R3").Select
ActiveCell.FormulaR1C1 = "ÀÁÑ"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("S3").Select
ActiveCell.FormulaR1C1 = "Ôèðìà-ïðîäàâåö"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Arial Cyr"
.FontStyle = "ïîëóæèðíûé"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Range("A3:S3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.AutoFilter

Range("L3").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").ColumnWidth = 3.5
Columns("G:G").ColumnWidth = 3.5
Columns("H:H").ColumnWidth = 3.5
Columns("I:I").ColumnWidth = 3.5
Columns("J:J").ColumnWidth = 3.5
Columns("K:K").ColumnWidth = 3.5
Columns("L:L").ColumnWidth = 3.5
Columns("M:M").ColumnWidth = 3.5
Columns("N:N").ColumnWidth = 3.5
Columns("O:O").ColumnWidth = 3.5
Columns("P:P").ColumnWidth = 3.5
Columns("Q:Q").ColumnWidth = 3.5
Columns("R:R").ColumnWidth = 3.5
Columns("S:S").ColumnWidth = 26.43

Columns("E:E").ColumnWidth = 5
Columns("B:B").ColumnWidth = 20.43
Range("A4").Select

End Sub

Private Sub LstMarka_Change()
If LstMarka.Selected(0) = True Then


For i = 1 To LstMarka.ListCount - 1
If LstMarka.Selected(i) = True Then
LstMarka.Selected(i) = False
End If

Next i
Exit Sub

End If

End Sub

Private Sub optbDollar_Click()

End Sub

Private Sub optbEvro_Click()

End Sub

Private Sub SpinBMax_Change()
FrmModel.TextMax.Value = SpinBMax.Value

End Sub

Private Sub SpinBMin_Change()

FrmModel.TextMin.Value = SpinBMin.Value
End Sub

Private Sub UserForm_Click()

End Sub
...
Рейтинг: 0 / 0
1 сообщений из 1, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / авто
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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