|
13.04.2012, 10:40
#37751870
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
Участник
Сообщения: 265
Рейтинг:
0
/ 0
|
|
|
|
AndreTM, отправляю:
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.
Public Sub OpenBook()
' открываем книгу, если книга не та, то возобновляется процедура открытия книги
Dim proverka As Boolean
proverka = True
zanovo: 'возвращаемся сюда, если выбрали не тот файл
proverka = True
Dim OpenBook As Workbook
Dim tempBook As Workbook
Dim tempsheet As Object
FileToOpen = Application.GetOpenFilename(Title:="Открыть файл", FileFilter:="Excel Files *.xls* (*.xls*),") 'диалог открытия книги
If FileToOpen = False Then
MsgBox "Файл не выбран", vbExclamation, "Информация"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
Set OpenBook = ActiveWorkbook
OpenBook.Activate
End If
Dim asd As Worksheet
'заполняем массив данными
Dim material(1 To 10000, 1 To 300) As String
Dim edinica(1 To 10000, 1 To 300) As String
Dim norma(1 To 10000, 1 To 300) As Single
Dim price(1 To 10000, 1 To 300) As Currency
Dim names(1 To 300) As String
Dim x, y, z, a, b, c
x = 0
y = 0
Dim stroka, temp
Application.DisplayAlerts = False
For Each asd In OpenBook.Worksheets
y = y + 1
x = 0
Do While Left(asd.Cells(9 + x, 5), 1) <> " "
x = x + 1
material(x, y) = asd.Cells(8 + x, 5)
edinica(x, y) = asd.Cells(8 + x, 7)
z = edinica(x, y)
edinica(x, y) = Replace(z, ".", "")
norma(x, y) = Val(asd.Cells(8 + x, 9))
price(x, y) = Val(asd.Cells(8 + x, 11))
Loop
names(y) = Mid(asd.Cells(2, 1), 53, 31) ' название продукции
Next
Dim newbook As Workbook 'объявляем переменную в качестве объекта книга
Set newbook = Workbooks.Add() 'этой переменной присваивается объект создаваемой книги
newbook.Activate ' активация созданной книги
newbook.Worksheets(3).Delete 'удаляем лишний лист
newbook.Worksheets(2).Delete 'удаляем еще один лишний лист
Workbooks.Open Filename:="C:\входящие\управляющие файлы\образец.xls" 'открываем книгу с образцом таблицы
Set tempBook = ActiveWorkbook 'присваиваем переменной темпбук открытую книгу
newbook.Worksheets(1).Range("A2:H19") = tempBook.Worksheets(1).Range("A2:H19")
ActiveWindow.Close 'закрываем книгу с образцом
newbook.Activate 'активируем изначально обрабатываемую книгу
For a = 1 To y 'здесь у - количество необходимых листов, полученный ранее
Set sh = newbook.Worksheets.Add(after:=ActiveSheet) 'вставка нового листа после активного (и до этого момента единстенного)
If Len(names(a)) > 30 Then
sh.Name = Left(names(a), 30) 'даем наименование листа из массива имен
Else: sh.Name = names(a)
End If
sh.Range("a2:H19") = newbook.Worksheets(1).Range("A2:H19") 'копируем шапку таблицы из первого листа
For b = 1 To x 'в этом цикле будет дополнена определенная работа внутри каждого создаваемого листа
Next b
newbook.Worksheets(a + 1).Activate
Next a
End Sub
|
|
|
