Реализация программного модуля, на встроенном языке программирования Visual Basic for Application (VBA), страница 13

Dim r1 As Integer

Dim r2 As Integer

'если план неоптимален

If fl = True Then

t = min(s(1), min(s(2), s(3)))

MsgBox t

k = 1

For i = 1 To 7 Step 1

For k = 1 To d2 Step 1

For j = 1 To 7 Step 1

If metka(i, j) <> "-->" And metka(j, i) <> "-->" And m(i, j) = 1 And k <= 3 Then

If сравниваем(p(i), p(j)) = True Then

s(k) = n(i, j) - (p(i) - p(j))

If p(i) < p(j) And s(k) = t Then

metka(i, j) = "-->": MsgBox "стрелочка i=" & i & ", j=" & j:  r1 = i: r2 = j

End If

If p(i) >= p(j) And s(k) = t Then

metka(i, j) = "-->": MsgBox "стрелочка i=" & i & ", j=" & j: r1 = i: r2 = j

End If

End If

If сравниваем(p(i), p(j)) = False Then

s(k) = n(i, j) - (p(j) - p(i))

If p(i) < p(j) And s(k) = t Then

metka(i, j) = "-->": MsgBox "стрелочка i=" & i & ", j=" & j: r1 = i: r2 = j

End If

If p(i) >= p(j) And s(k) = t Then

metka(i, j) = "-->": MsgBox "стрелочка i=" & i & ", j=" & j: r1 = i: r2 = j

End If

End If

End If

Next j

Next k

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

Worksheets("Лист1").Cells(i + 6, j + 8) = metka(i, j)

Next j

Next i

'определение величины поставки для "загружаемого " ребра

If контур1 = True Then

Call kontur1(r1, r2)

MsgBox 1

End If

If контур2 = True Then

Call kontur2(r1, r2)

MsgBox 2

End If

If контур3 = True Then

Call kontur3(r1, r2)

MsgBox 3

End If

If контур4 = True Then

Call kontur4(r1, r2)

MsgBox 4

End If

If контур5 = True Then

Call kontur5(r1, r2)

MsgBox 5

End If

If контур6 = True Then

Call kontur6(r1, r2)

MsgBox 6

End If

If контур7 = True Then

Call kontur7(r1, r2)

MsgBox 7

End If

End If

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

Worksheets("Лист3").Cells(i + 100, j + 100) = ""

Next j

Next i

Loop While fl = True

End Sub

Private Sub CommandButton2_Click()

ComboBox1.Text = ""

ComboBox2.Text = ""

ComboBox3.Text = ""

ComboBox4.Text = ""

ComboBox5.Text = ""

ComboBox6.Text = ""

ComboBox7.Text = ""

ComboBox8.Text = ""

ComboBox9.Text = ""

ComboBox10.Text = ""

ComboBox11.Text = ""

ComboBox12.Text = ""

ComboBox13.Text = ""

ComboBox14.Text = ""

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

TextBox7.Text = ""

TextBox8.Text = ""

TextBox9.Text = ""

TextBox10.Text = ""

TextBox11.Text = ""

TextBox12.Text = ""

TextBox13.Text = ""

TextBox14.Text = ""

TextBox15.Text = ""

TextBox16.Text = ""

End Sub

Private Sub CommandButton3_Click()

Me.Hide

UserForm1.Show

End Sub

Private Sub CommandButton4_Click()

Unload UserForm1

Unload Me

End Sub

Private Sub UserForm_Initialize()

For i = 1 To 7 Step 1

With ComboBox1

.AddItem i

End With

With ComboBox2

.AddItem i

End With

With ComboBox3

.AddItem i

End With

With ComboBox5

.AddItem i

End With

With ComboBox6

.AddItem i

End With

With ComboBox7

.AddItem i

End With

With ComboBox8

.AddItem i

End With

With ComboBox9

.AddItem i

End With

With ComboBox10

.AddItem i

End With

With ComboBox11

.AddItem i

End With

With ComboBox12

.AddItem i

End With

With ComboBox13

.AddItem i

End With

With ComboBox14

.AddItem i

End With

Next i

End Sub

Public Function контур1() As Boolean

Dim w(1 To 7, 1 To 7) As String

Dim s As String

s = "-->"

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

w(i, j) = Worksheets("Лист1").Cells(i + 6, j + 8)

Next j

Next i

If w(2, 5) = s And w(2, 6) = s And w(3, 5) = s And w(3, 6) = s Then

контур1 = True

Else

контур1 = False