olik111 » 14.01.2005 (Пт) 11:16
Private Sub CommandButton1_Click()
'Dim j As Integer ' типа номер текущего договора
Dim objWord As Object
Dim chislo_vid As String
Dim munth_vid As String
Dim chislo1_vid As String
Dim munth1_vid As String
Dim year_vid As String
Dim year1_vid As String
Dim FIO_Isp As String
Dim FIO_Vid As String
Dim addres As String
Dim Mesto As String
Dim Text_Texusl As String
Dim number As String
Dim ispolnitel As String
chislo_vid = TextBox4.Text
munth_vid = TextBox5.Text
chislo1_vid = TextBox4.Text
munth1_vid = TextBox5.Text
year_vid = TextBox6.Text
year1_vid = TextBox6.Value + 1
FIO_Isp = ComboBox1.Text
FIO_Vid = TextBox1.Text
addres = TextBox2.Text
Mesto = TextBox3.Text
Text_Texusl = TextBox7.Text
ispolnitel = ComboBox1.Text
File = ThisWorkbook.Path & "\Техусловия.doc"
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
' Откроем техусловие
.documents.Open Filename:=File
End With
With Worksheets("Выполняемые")
.EnableSelection = xlNoRestrictions
.Protect Contents:=True
End With
Worksheets("Выполняемые").Unprotect Password:="123"
'Занесём данные в шаблон договора
Sheets("Выполняемые").Select
For i = 6 To 10000
If Cells(i, 1).Value = "" Then
Randomize
Cells(i, 1).Value = Rnd()
Cells(i, 2).Value = FIO_Vid
Cells(i, 3).Value = addres
Cells(i, 4).Value = Mesto
Cells(i, 5).Value = chislo_vid & "." & munth_vid & "." & year_vid
Cells(i, 6).Value = chislo_vid & "." & munth_vid & "." & year_vid + 1
number = Cells(i, 1)
Exit For
End If
Next
showEmptyRecord
objWord.Selection.Find.Text = "[кому]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=FIO_Vid
objWord.Selection.Find.Text = "[адрес]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=addres
objWord.Selection.Find.Text = "[номер]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=number
objWord.Selection.Find.Text = "[число]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=chislo_vid
objWord.Selection.Find.Text = "[месяц]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=munth_vid
objWord.Selection.Find.Text = "[год]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=year_vid
objWord.Selection.Find.Text = "[Текст]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=Text_Texusl
objWord.Selection.Find.Text = "[число1]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=chislo1_vid
objWord.Selection.Find.Text = "[месяц1]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=munth1_vid
objWord.Selection.Find.Text = "[год1]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=year1_vid
objWord.Selection.Find.Text = "[Исполнитель]"
objWord.Selection.Find.Execute
objWord.Selection.TypeText Text:=ispolnitel
' Сохраним договор под новым именем
File = ThisWorkbook.Path & "\Техусловия " & number & ".doc"
objWord.ActiveDocument.SaveAs Filename:=File
'Select Case MsgBox("Печатать документ?", vbYesNo + vbQuestion)
'Case vbYes
'objWord.ActiveDocument.PrintOut copies:=3
'закроем Договор
objWord.ActiveDocument.Close
objWord.Quit
Set objWord = Nothing
For i = 6 To 10000
If Cells(i, 10).Value = "" Then
With Worksheets("Выполняемые")
.Hyperlinks.Add Anchor:=.Cells(i, 10), _
Address:="file:///C:\Техусловия\Техусловия " & number & ".doc"
End With
Exit For
End If
Next
UserForm1.Hide
Worksheets("Выполняемые").Range("g:h").Locked = False
Worksheets("Выполняемые").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub