filmax
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Всем привет!
Есть макросы, который обрабатывает данные в excel документе, передает результат в Word, а excel закрывает без сохранения
******************************************************
Sub scheta2() ЭТОТ МАКРОС ДЛЯ УАЗОВ
'
Dim sch, dv, kuz, vin As Variant
Dim i, j As Integer
i = 2
j = 3
sch = Worksheets(1).Cells(i, j)
While Worksheets(1).Cells(i, j) <> Empty
sch = "ш." & Worksheets(1).Cells(i, j)
Worksheets(1).Cells(i, j) = sch
kuz = "куз." & Worksheets(1).Cells(i, j + 1)
Worksheets(1).Cells(i, j + 1) = kuz
dv = "дв." & Worksheets(1).Cells(i, j + 2)
Worksheets(1).Cells(i, j + 2) = dv
vin = "VIN " & Worksheets(1).Cells(i, j + 3)
Worksheets(1).Cells(i, j + 3) = vin
Worksheets(1).Cells(i + 25, j - 1).Select
Worksheets(1).Cells(i + 25, j - 1) = sch & " " & dv & " " & kuz & " " & vin
i = i + 1
k = i - 2
Wend
x1 = i + 25 - k
y1 = i + 25 - 1
x = "B" & x1
y = "B" & y1
Worksheets(1).Range(x, y).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
Selection.Copy
With CreateObject("Word.Application")
.Documents.Add
.Selection.Paste ??????
.Visible = True
.Activate
End With
ActiveWorkbook.Close False
Excel.Application.Quit
End Sub
************************************************************
Sub scheta() ЭТОТ МАКРОС ДЛЯ ГАЗОВ
'
Dim sch, dv, kuz, vin, x, y As Variant
Dim f As Variant
Dim i, j, k, x1, y1 As Integer
i = 26
j = 3
sch = Worksheets(1).Cells(i, j)
While Worksheets(1).Cells(i, j) <> Empty
sch = "ш." & Worksheets(1).Cells(i, j)
Worksheets(1).Cells(i, j) = sch
dv = "дв." & Worksheets(1).Cells(i, j + 1)
Worksheets(1).Cells(i, j + 1) = dv
kuz = "куз." & Worksheets(1).Cells(i, j + 2)
Worksheets(1).Cells(i, j + 2) = kuz
vin = "VIN " & Worksheets(1).Cells(i, j + 3)
Worksheets(1).Cells(i, j + 3) = vin
Worksheets(1).Cells(i + 25, j - 1).Select
If sch = "ш.отсутствует" Then
Worksheets(1).Cells(i + 25, j - 1) = dv & " " & kuz & " " & vin
Else
Worksheets(1).Cells(i + 25, j - 1) = sch & " " & dv & " " & kuz & " " & vin
End If
i = i + 1
k = i - 26
Wend
x1 = i + 25 - k
y1 = i + 25 - 1
x = "B" & x1
y = "B" & y1
Worksheets(1).Range(x, y).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
Selection.Copy
With CreateObject("Word.Application")
.Documents.Add
.Selection.Paste
.Visible = True
.Activate
End With
ActiveWorkbook.Close False
Excel.Application.Quit
End Sub
*************************************************************************
На 6 машинах все нормально, а на 7-й останавливается на " .Selection.Paste"
Данные которые обрабатыаются - http://rapidshare.com/files/248514506/data.rar.html
|
Всего записей: 220 | Зарегистр. 12-10-2002 | Отправлено: 17:50 25-06-2009 | Исправлено: filmax, 18:13 25-06-2009 |
|
