Sub ÎòêðûòèåÊíèãèÌîä Dim filePath As String filePath St Ñëó àéíûå èñëà

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub ÎòêðûòèåÊíèãèÌîä()
Dim filePath As String
filePath = "C:\St\Ñëó÷àéíûå ÷èñëà.xls"
Dim sheetName As String
sheetName = "Ñëó÷. ÷èñëà"
If Len(Dir$(filePath)) <= 0 Then
MsgBox "Ôàéë ñ ïîëíûì ïóòåì " + filePath + " íå íàéäåí!"
Exit Sub
End If
If IsBookOpen(filePath) Then
MsgBox "Êíèãà óæå îòêðûòà!"
Else
MsgBox "Êíèãà çàêðûòà!"
End If
Dim myWorkbook As Workbook
Set myWorkbook = Workbooks.Open(filePath)
Dim sheetNumber As Integer
sheetNumber = -1
For i = 1 To myWorkbook.Worksheets.Count
If myWorkbook.Worksheets(i).Name = sheetName Then
sheetNumber = i
Exit For
End If
Next i
If sheetNumber = -1 Then
MsgBox "Ëèñòà ñ èìåíåì 'Ñëó÷. ÷èñëà' íå îáíàðóæåíî"
Exit Sub
End If
Dim mySheet As Worksheet
Set mySheet = myWorkbook.Worksheets(sheetNumber)
Dim firstEmptyLine As Integer
firstEmptyLine = 1
While Trim(mySheet.Cells(firstEmptyLine, 1).Value) <> ""
firstEmptyLine = firstEmptyLine + 1
Wend
Dim random() As Integer
random = RandomNumbers()
For i = firstEmptyLine To firstEmptyLine + 5
mySheet.Cells(i, 1).Value = i - firstEmptyLine + 1
Next i
myWorkbook.Save
MsgBox "Ñëó÷àéíûå ÷èñëà ðàçûãðàíû!"
End Sub
Function IsBookOpen(wbFullName As String) As Boolean
Dim iFF As Integer
iFF = FreeFile
On Error Resume Next
Open wbFullName For Random Access Read Write Lock Read Write As #iFF
Close #iFF
IsBookOpen = Err
End Function
Function RandomNumbers() As Integer()
Dim numbers(1 To 5) As Integer
For i = 1 To 5
numbers(i) = Int(100 * Rnd())
Next i
RandomNumbers = numbers
End Function