Автоматическая разноска данных из текст. файла в форму WORD

[to_south]

Добрый день! Есть простой текстовый файл со строкой данных, разделенных знаком &. Нужно в Ворде нарисовать форму с полями и чтобы этот текстовый файл автоматом втягивался и разносились данные по полям. Как это решить пока совершенно не представляю... Помогите, пожалуйста, разобраться с этой задачей.

[to_south]

Неужели никто не знает, хотя бы как в общем сделать?

[shanemac51]

--ГДЕ ТЕКСТОВЫЙ ФАЙЛ
--ПРОЧИТАТЬ --ОТРЕДАКТИРОВАТЬ И ЗАПИСАТЬ НАЗАД
--ИЛИ ПРОЧИТАТЬ И ЗАПИСАТЬ В ВОРД-ДОКУМЕНТ
-----------
просите что=то сделать, не дав никакой онформации

[viter.alex]

Знаем как сделать, но условия задачи очень не конкретные. В нижеприведённом коде "рисуется" форма с полями, текстовый файл "автоматом втягивается" и разносятся данные по полям. Код макроса вставить в новый модуль

Option Explicit
Dim arFields As Variant
Sub Test()
    Dim oFrm
    Dim sFileName As String
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Открыть файл"
        .ButtonName = "Открыть"
        .Filters.Clear: .Filters.Add "Все файлы", "*.*"
        If .Show Then
            sFileName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Dim FileNum As Byte: FileNum = FreeFile
    Dim sBuff As String
    Open sFileName For Binary As FileNum
    sBuff = Space(LOF(FileNum))
    Get #FileNum, , sBuff
    Close FileNum
    
    If Len(Trim(sBuff)) = 0 Then Exit Sub
    
    arFields = Split(sBuff, "&")
    
    Set oFrm = ThisDocument.VBProject.VBComponents.Add(3)
    Dim sCode As String
    
    sCode = sCode & "Sub UserForm_Initialize()" & vbCrLf
    sCode = sCode & vbTab & "GetControlsForForm Me, " & UBound(arFields) & vbCrLf
    sCode = sCode & "End Sub" & vbCrLf
    oFrm.CodeModule.InsertLines oFrm.CodeModule.CountOfLines + 1, sCode
    
    VBA.UserForms.Add(oFrm.Name).Show
    ThisDocument.VBProject.VBComponents.Remove oFrm
End Sub

Sub GetControlsForForm(oFrm As Object, NumberOfTextboxes As Integer)
    Dim i As Integer
    Dim oTxt As MSForms.TextBox
    Dim iLeft As Integer, iTop As Integer
    Dim iMaxWidth As Integer, iMaxHeight As Integer
    iLeft = 6: iTop = 6
    
    For i = 0 To NumberOfTextboxes
        Set oTxt = oFrm.Controls.Add("Forms.TextBox.1", "txtField" & i)
        With oTxt
            .Text = arFields(i)
            .Left = iLeft: .Top = iTop
            iTop = iTop + .Height
            iMaxWidth = iLeft + .Width + 6
            iMaxHeight = iTop + .Height + 20
        End With
    Next
    oFrm.Height = iMaxHeight: oFrm.Width = iMaxWidth
End Sub

[to_south]

Сообщение от shanemac51

--ГДЕ ТЕКСТОВЫЙ ФАЙЛ
--ПРОЧИТАТЬ --ОТРЕДАКТИРОВАТЬ И ЗАПИСАТЬ НАЗАД
--ИЛИ ПРОЧИТАТЬ И ЗАПИСАТЬ В ВОРД-ДОКУМЕНТ
-----------
просите что=то сделать, не дав никакой онформации

Простите, прикрепила текстовый файл со строкой данных и пример шаблона формы word. Нужно чтобы при открытии текст. файла поля автоматически разносились по форме.

[to_south]

Сообщение от viter.alex

Знаем как сделать, но условия задачи очень не конкретные. В нижеприведённом коде "рисуется" форма с полями, текстовый файл "автоматом втягивается" и разносятся данные по полям. Код макроса вставить в новый модуль

viter.alex, спасибо! Пока пытаюсь разобраться...

[shanemac51]

Примерно так
--не прописала только чтение файла
--и не ясно --есть ли зацикливание (например все студенты группы)

Sub a______________1130()
ss = "Familiya&Волков&Imya&Oleg&Vozrast&28&Gorod&Волгоград&Ulica&Мира&Dom&5&"
Dim xm
xm = Split(ss & "#&#&", "&")
j1 = LBound(xm, 1)
j2 = UBound(xm, 1)
Do While j1 < j2
Debug.Print j1, xm(j1), xm(j1 + 1)
j1 = j1 + 2
Loop
j1 = LBound(xm, 1)

Word.ActiveDocument.SaveAs "c:\RAB\" & xm(j1 + 1) & "_" & xm(j1 + 3) & "_" & xm(j1 + 5) & ".DOCX"

''''''''''''''''''''''
Dim zakl As Bookmark
j31 = Word.ActiveDocument.Bookmarks.Count
Do While j31 > 0
Set zakl = Word.ActiveDocument.Bookmarks(j31)
j1 = LBound(xm, 1)
Do While j1 < j2
Debug.Print zakl.Name
If xm(j1) = zakl.Name Then
zakl.Range.Text = xm(j1 + 1)
'Debug.Print zakl.Range.Text
Exit Do
End If
j1 = j1 + 2
Loop
j31 = j31 - 1
Loop

End Sub