Шаблоны в WORD

[tofik]

Есть вордовский файл с шаблоном имени!
В форме есть грид, в нем ФИО сотрудников!
Кнопочка "Печать по шаблону", печатает вордовский файл и вместо шаблона имени, подставляя ФИО выбранного в гриде сотрудника!
Вопрос: Как мне из VB передать в WORD это ФИО и обеспечить печать?

[Igor_123]

Откраваешь из ВБ Ворд, ищешь поля где надо менять и заменяешь на нужные, отправляешь на печать
Удачи!

[tofik]

=)
это ясно!
я имел ввиду как это выглядет в коде!!!

[ZlydenGL]

Dim Wrd as Word.Application
...
Wrd.Tables(1).Cell(1,2).Select
Selection.Text=MyFIO

Проще думаю не придумать. Только как видишь, я предполагаю что ФИО пишется (или должно подставляться) в таблицу.

Удачи!

[tofik]

А как найти в шаблоне Word, поля которые мне нужно заменить?

[ZlydenGL]

Если возьмешь за пример мой кусок кода, то ФИО должно содержаться в первой таблице документа в первой строке второй колонке слева

[tofik]

а можешь расписать, что подразумевается в твоем коде под "..."
плиз

[Igor_123]

Если знаешь координаты ячеек то да, а если ячейки имеют объединения тогда такой вариант может не пройти
Это грузится из тхт информация для коммерческое предложение
код находится в модуле шаблона и запускается из ВБ
вот тхт для примера, картинки.
Посмотри, я переделал это на таблицу, но сейчас нет под рукой.
Найду дам.
А вообще запиши поиск и замену в макрос, измени точку зрения выполнения на из-вне ворда и запускай.
Вот этим я запускаю

Код: Выделить всё

'##ModelId=40CE7DA50226
Public Function GoDoOffer() As Boolean
Dim i As Long, j As Long
Dim PathF As String
Dim sum As Double
Dim temps As String
Dim FullCount As Long
FullCount = 0
j = 0
sum = 0
PathF = App.Path & "\Offers\"
If mvarInfoForOffers Is Nothing Then Exit Function
If Not ActivateWord Then Exit Function

WordObj.Visible = True

If Not ReadTitle Then
    Call DefaultTitle
End If

If Not ReadCaption Then
    Call DefaultCaption
End If

On Error GoTo labFileName
Open PathF & mvarNameZakazForFileName & ".txt" For Output As #1
'    Print #1, ""
Print #1, strTitle(0)
If Len(mvarNameZakaz) > 0 Then
    Print #1, Replace(strTitle(1), "_____*_______", mvarNameZakaz, 1, -1, vbTextCompare)
End If
If Len(mvarNameZakazchik) > 0 Then
    Print #1, Replace(strTitle(3), "_____*_______", mvarNameZakazchik, 1, -1, vbTextCompare)
End If
If Len(mvarAddress) > 0 Then
    Print #1, Replace(strTitle(4), "_____*_______", mvarAddress, 1, -1, vbTextCompare)
End If
If Len(mvarPhoneZakazchik) > 0 Then
    Print #1, Replace(strTitle(5), "_____*_______", mvarPhoneZakazchik, 1, -1, vbTextCompare)
End If

Dim Info As clsInfoForOffer
'PathF = PathF & "Offer" & CStr(j) & ".bmp"
For Each Info In mvarInfoForOffers
    With Info
        If Not .PictureDesign Is Nothing Then
            SavePicture .PictureDesign, PathF & "Offer" & CStr(j) & ".bmp"
        Else
            MsgBox "Ïîïûòêà ñîçäàòü êîììåð÷åñêîå ïðåäëîæåíèå íå óâåí÷àëàñü óñïåõîì." _
                & vbCrLf & "Ïîïûòàéòåñü åù¸ ðàç", vbInformation Or vbOKOnly, "Ðàñ÷åò"
            Exit Function
        End If
    End With
    Print #1, "[picture]"
    Print #1, PathF & "Offer" & CStr(j) & ".bmp"
    j = j + 1
    For i = 0 To UBound(strCaption) - 1
        If Len(Info.Item(i)) > 0 Then
            If 6 = i And "1" = Info.Item(i) Then
                Print #1, Replace(strCaption(i), "__*__", Info.Item(i), 1, -1, vbTextCompare)
'                MsgBox Format(Date, "dd mmmm yyyy") 'VBA.FormatDateTime(Date, 1)
                temps = Replace(strCaption(i + 1), "__*__", Info.Item(i + 1), 1, -1, vbTextCompare)
                temps = Replace(temps, " îäíîãî ", " ", 1, -1, vbTextCompare)
                Print #1, temps
                i = UBound(strCaption) + 2
            Else
                Print #1, Replace(strCaption(i), "__*__", Info.Item(i), 1, -1, vbTextCompare)
            End If
        End If
    Next i
    FullCount = FullCount + Info.Item(6)
    sum = sum + Info.Item(8)
Next
Print #1, vbCrLf
Print #1, "Îáùåå êîëè÷åñòâî èçäåëèé â çàêàçå - " _
                & CStr(FullCount) & " øò."
Print #1, "Îáùàÿ ñòîèìîñòü âñåãî çàêàçà - " _
                & Format(sum, "**#,##0.00") & " ãðí."
Close #1
SaveSetting "ViewDesign", "Offer", "Offer", PathF & mvarNameZakazForFileName & ".txt"
On Error GoTo labWord
'Set WordDoc = WordObj.Documents.Add(App.Path & "\Offer.dot")
Set WordDoc = WordObj.Documents.Add(Template:= _
        App.Path & "\Offer.dot", NewTemplate:=False, DocumentType:=0)
WordObj.Run "NewOffer" ', PathF & mvarNameZakazForFileName & ".txt"
Set WordDoc = Nothing
Set WordObj = Nothing

'WordObj.Options.SavePropertiesPrompt = False
'On Error GoTo labFileName
'WordDoc.SaveAs PathF & mvarNameZakazForFileName & ".doc"
'WordObj.Options.SavePropertiesPrompt = True
'
'With WordObj.Selection
'    .TypeText Text:=strTitle(0)
'    .ParagraphFormat.Alignment = 1 'wdAlignParagraphCenter
'    .MoveLeft Unit:=wdCharacter, Count:=Len(strTitle(0)), Extend:=wdExtend
'    .font.Size = 18
'    .EndKey Unit:=wdLine
'    .TypeParagraph
'    .TypeParagraph
'    .TypeParagraph
'    .font.Size = 12
'    .ParagraphFormat.Alignment = 0 'wdAlignParagraphLeft
'    .TypeText Text:=Replace(strTitle(1), "_____*_______", mvarNameZakaz, 1, 4, vbTextCompare)
'    .TypeParagraph
'    .TypeParagraph
'    .TypeText Text:=strTitle(2)
'    .TypeParagraph
'    .TypeParagraph
'    .TypeText Text:=Replace(strTitle(3), "_____*_______", mvarNameZakazchik, 1, 4, vbTextCompare)
'    .TypeParagraph
'    .TypeParagraph
'    .TypeText Text:=Replace(strTitle(4), "_____*_______", mvarAddress, 1, 4, vbTextCompare)
'    .TypeParagraph
'    .TypeParagraph
'    .TypeText Text:=Replace(strTitle(5), "_____*_______", mvarPhoneZakazchik, 1, 4, vbTextCompare)
'    .TypeParagraph
'End With

'Dim Info As clsInfoForOffer
'PathF = PathF & "Offer.bmp"
'For Each Info In mvarInfoForOffers
'    With Info
'        SavePicture .PictureDesign, PathF
'    End With
'    With WordObj
'        With .Selection
'            With .InlineShapes
'                .AddPicture PathF
''                With .AddPicture(PathF) '(FileName As String, [LinkToFile], [SaveWithDocument], [Range]) As InlineShape
''                    With .Fill
''                        .Visible = 0 'msoFalse
''                        .Solid
''                        .Transparency = 0#
''                    End With
''                    With .Line
''                        .Weight = 0.75
''                        .Transparency = 0#
''                        .Visible = 0 'msoFalse
''                    End With
''                    .LockAspectRatio = -1 'msoTrue
''        '            .Height = 85.05
''        '            .Width = 113.4
''                    With .PictureFormat
''                        .Brightness = 0.5
''                        .Contrast = 0.5
''                        .ColorType = 1 'msoPictureAutomatic
''                        .CropLeft = 0#
''                        .CropRight = 0#
''                        .CropTop = 0#
''                        .CropBottom = 0#
''                    End With
''                End With
'            End With
'            .TypeParagraph
'            .TypeParagraph
'            For i = 0 To UBound(strCaption) - 1
'                .TypeParagraph
'                .TypeText Text:=Replace(strCaption(i), "__*__", Info.Item(i), 1, -1, vbTextCompare)
'                .TypeParagraph
'            Next i
'
'            sum = sum + Info.Item(8)
'        End With
'    End With
'Next
'With WordObj.Selection
'    .TypeParagraph
'    .TypeText Text:="Îáùàÿ ñòîèìîñòü âñåãî çàêàçà áåç ôóðíèòóðû - " & CStr(sum) & " ãðí."
'    .HomeKey Unit:=wdLine, Extend:=wdExtend
'    .font.Size = 16
'    .font.Bold = wdToggle
'    .EndKey Unit:=wdLine
'End With
Exit Function

labFileName:
mvarNameZakazForFileName = mvarNameZakazchik & g_GenerateId.NowForFileName
Resume
labWord:
Debug.Print "Error in WordObj"
Resume Next
End Function

и тоже есть более свежий вариант
Вообщем удачи! Ты ет, пиши если че! (с) "Жил, был пес"

[ZlydenGL]

Гррр!!! Тебе к начинающим, парень!

Код: Выделить всё

Dim wrd as Word.Application

Set wrd = CreateObject("Word.Application")
...
wrd.Documents.Open MyFile
wrd.ActiveDocucment.Tables(1).Cell(1,2).Select
For I = 0 To Грид.Rows-1
wrd.Selection.Text = Грид.Cells(I,1)
wrd.ActiveDocument.PrintOut
Next I

Igor_123, не слишком это будет сложно для начинающего? Тем более что ему текст сам создавать не надо, только брать файл-шаблон.

P.S. Только что проверил на объединенных ячейках - пашет!

[Igor_123]

Забыл присоеденить файло

[Igor_123]

P.S. Только что проверил на объединенных ячейках - пашет!

Можно очень нарватся! Лучше пашет если обходить как коллекцию ячеек! Намного лучше!

[TEH3OP]

А ещё лучше назначить Bookmark'и (закладку) на нужные места в документе.
Тогда ненадо будет юзать вонючий Selection ==> делаться документ будет МОМЕНТАЛЬНО!

НО!
Грабли1: после изменения текста в некотором Bookmark'е сам он сдохнет.
Грабли2: если Bookmark повесить на диапазон, то текст этого диапазона будет заменён, а если Bookmark повесить на позицию (пустой диапазон) то текст будет вставлен на эту позицию.

[alibek]

Оба вида грабель лечаться следующим способом.
Создается документ нужного вида с Bookmark'ами в нужных местах. Затем весь этот текст выделяется, сохраняется в автотекст, а из документа удаляется.
Программа создает документ, вставляет элемент автотекста, заменяет Bookmark'и на значения. Затем снова вставляет элемент автотекста и снова заменяет Bookmark'и, и т.д.

[tofik]

Private Sub Command1_Click()
Dim wrd As Word.Application
Set wrd = CreateObject("Word.Application")
wrd.Documents.Open "D:\aaa.dot"
Set a = wrd.ActiveDocument
a.Fields.Item(1).Data = "яяя"
wrd.ActiveDocument.PrintOut
End Sub

а он мне на строчке
a.Fields.Item(1).Data = "яяя"
говорит "<Поле не может содержать данные.> "

[ZlydenGL]

Думаю тебе усе едино надо Select'ом пользоваться, а потом Selection.Text = "яяя"