Sub SM_Z()
'
' Макрос записан 02.03.2005 (Efimov)
'
FRM = "=MAX('[Список студентов.xls]Список групп'!R4C1:R13C1)"
Range("B5").Formula = FRM
m = 3 + Range("B5").Value
ActiveSheet.Shapes("Group").Select
With Selection
.ListFillRange = "'[Список студентов.xls]Список групп'!$B$4:$B$" & m
.LinkedCell = "$I$3"
.DropDownLines = Range("B5").Value
.Display3DShading = True
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(R3C9,'[Список студентов.xls]Список групп'!R4C1:R13C2,2)"
ActiveSheet.Shapes("Bill").Select
GR = Range("E2").Value
FRM = "=MAX('[Список студентов.xls]" & GR & "'!R8C1:R38C1)"
Range("A5").Formula = FRM
m = 7 + Range("A5").Value
With Selection
.ListFillRange = "'[Список студентов.xls]" & GR & "'!$B$8:$B$" & m
.LinkedCell = "$A$4"
.MultiSelect = xlNone
.Display3DShading = True
End With
FRM = "=VLOOKUP(R4C1,'[Список студентов.xls]" & GR & "'!R4C1:R" & m & "C4,2)"
Range("B4").Select
ActiveCell.FormulaR1C1 = FRM
FRM = "=VLOOKUP(R4C1,'[Список студентов.xls]" & GR & "'!R4C1:R" & m & "C4,3)"
Range("D4").Select
ActiveCell.FormulaR1C1 = FRM
FRM = "=VLOOKUP(R4C1,'[Список студентов.xls]" & GR & "'!R4C1:R" & m & "C4,4)"
Range("F4").Select
ActiveCell.FormulaR1C1 = FRM
If ActiveSheet.Name = "Задание" Then
Prep = "='[Список студентов.xls]" & GR & "'!R5C4"
Range("I23").Formula = Prep
End If
End Sub
Sub Print_zsm()
'
N = Range("A5")
For i = 1 To N
Range("A4").Value = i
Application.Run "'Комплектование машин по объектам строительства__мг_mod.xls'!GSN"
pa = "A1:" & Cells(1, 1)
ActiveSheet.PageSetup.PrintArea = pa
ActiveSheet.PageSetup.PrintArea = pa
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
End Sub
Sub GSN()
'
' Макрос1 Макрос
' Макрос записан 18.06.2009 (Владимир Ефимов)
'
'
Dim c(8) ' массив для значений ядра
Dim s(200) ' массив для случайных чисел
c(1) = 37584381
c(2) = 190999663
c(3) = 196446317
c(4) = 123567149
c(5) = 1480745561
c(6) = 442596621
c(7) = 340029183
c(8) = 203022663
Range("F3").Select
ActiveCell.FormulaR1C1 = _
"=RIGHT(RC[-2],LEN(RC[-2])-FIND(""-"",RC[-2],LEN(RC[-2])-3))"
nc = Cells(3, 6)
If nc > 8 Then nc = 8
mn = Len(Cells(4, 2)) & Len(Cells(4, 4)) & Len(Cells(4, 6)) + Cells(4, 1)
mnm = mn Mod 2
If mnm = 0 Then mn = mn + 1
bb = c(nc) * mn
mn = Right(bb, 4)
For i = 1 To 200
bb = c(nc) * mn
mn = Right(bb, 4)
s(i) = Right(bb, 8) / 100000000
'Cells(i + 5, 9) = s(i)
Next i
'
'--------- конец генератора случайных чисел --------
'
ni = 10
nj = 10
For i = 1 To ni
For j = 1 To nj
k = j + nj * (i - 1)
Cells(i + 9, j + 1) = Cells(10, 12) - Cells(10, 13) + 2 * Cells(10, 13) * s(k)
Next j
Next i
'
' ------- заполнили матрицу затрат
'
If ActiveSheet.Name = "Решение" Then
[B56:K65] = 0
SolverOk SetCell:="$D$54", MaxMinVal:=2, ValueOf:="0", ByChange:="$B$56:$K$65"
SolverSolve UserFinish:=True
End If
End Sub
Sub Main_m()
Application.Run "'Комплектование машин по объектам строительства__мг_mod.xls'!SM_Z"
Application.Run "'Комплектование машин по объектам строительства__мг_mod.xls'!GSN"
End Sub
Первый раз имею дело с макросами.
Надеюсь то что надо скопировал
