Работа с файлами Excell и Word через VBA

[Bagathur]

Дано: В формате Excell есть список, содержащий номера, фамилии, даты и прочую информацию. В формате Word есть "рыбы" документов.
Требуется: немного обработав данные из Excell , заменить автозаменой условных значения из "рыбы" на нужные значения списка (например, "дата№1" в рыбе на "21.08.2006") и сохранить изменённые "рыбы" под новыми именами в новой папке.
Проблема в том, что не могу заставить написанные в Экселе макросы открывать файлы Ворда и работать с ними, равно как и наоборот. Не получается занести все требуемые к изменению данные в переменные и заставить макросы Ворда воспринимать их. Код Ворда для открытия файлов Эксель не воспринимает - просит какой-то объект.
Смотрел во многих местах, но путного ответа не увидел - лишь какие-то безумно-сложные для ламера слова типа ShellExecute и тп.

Помогите плиз.

[GSerg]

Ворд - Сервис - Параметры - Слияние

[Bagathur]

Ворд - Сервис - Параметры...
И всё. У меня дальше страница из 11 закладок, среди которых "Слияние" нет.
В справке про слияние много чего пишут, но тоже ничего путного.
Плюс есть ещё панель инструментов слияние, но это тоже не помогает.

[Viper]

Все чуть проще: Сервис - Слияние...

[Bagathur]

Откопал это ваше слияните, только с большим трудом)
Жаль только что этот инструмент в данном случае не подходит - слишком мало возможностей. Тут требуется автозаменой менять в "рыбе" слишком много и слишком разные слова-преложения в текстах по 10-200 страниц по 600-800 автозамен (общее число).
А мастер слияний всё время просит какие-то адреса и пытается заставить меня писать кому-то письма.

[GSerg]

А не надо пользоваться мастером слияния.
Надо выбрать источник данных, ворд возьмёт список полей, и эти поля надо ручками раскидать по документу.
А для изменения существует поле { IF }
А возможностей у слияния гораздо больше, чем ты думаешь, и уж намного больше, чем можно подумать, глядя на мастер слияния.

[Bagathur]

Значит я не то откопал.
Где тогда лежит это слияние? В сервис-слияние на него нет даже намёка, равно как и в сервис-настройка-слияние. Где тогда оно может прятаться?
Да и всё равно не думаю что слияние сможет сделать то, что мне надо - требуется неограниченно длинный список замены как по столбцам, так и по строкам, плюс возможность задавать неограниченное непоследовательное количество имён файлов, под которыми будет сохраняться одна и та же изменённая "рыба". Да и обработка значений одной ячейки нужна - хотя бы для того, чтобы отделять номер от даты и инициалы от имени, плюс писать сумму цифрами в различных текстово-цифровых форматах.

[GSerg]

Там лежит, там, всё правильно.

Хотя наверное да, лучше руками. Но задача какая-то уж больно извращённая... не опишешь в неабстрактных терминах?

[Bagathur]

Уже Вордов штук 20 облазил в поисках этого мифического "слияния" - везде есть только мастер, и то в панели инструментов, не в подокне "сервис")

Если говорить в неабстрактых терминах - есть штук 30 различных типов документов (договора, акты, соглашения, приложения, счета, счета-фактуры, платёжные поручения, медиа-планы, заявки, заказы и т.п., некоторых по 10 разных подтипов). Текст, форма и форматирование каждого документа - один в один, различаются только даты, суммы, реквизиты, номера, фамилии бухгалтеров и генеральных директоров и т.п.

Таких документов в месяц приходится делать примерно на 1500 страниц. До меня (я пришёл с армии 2 недели назад, работаю и того меньше) всё это делала банда девушек вручную - открывали документ за прошлый месяц и ручками правила все цифирки-буковки.

Я хочу сделать рыбу каждого документа, вводить в экселевский файл т.н. "список автозамены", потом жать волшебную кнопочку в юзер-форме и сразу формировать пакет документов на одну или несколько фирм.

Проблема осложняется тем, что необходимо немного обрабатывать данные автозамены - например, где-то требуется написать "Иванов Иван Иванович", где-то - "Иванов И.И." или даже "И.И.Иванов"; где-то надо просто 1000.00р, где-то - тысяча рублей 00 копеек, плюс ещё 2 варианта числового-текстового написания суммы; ну и перевод месяцев из чисел в текст и обратно.

Хотелось бы сделать логическую подпрограммку для замены числа "объекта" и правильного склонения по падежам (например, чтобы заменяло в "рыбе" "медиа-план" на "медиа-планы" автоматом, если их в поле ввода указано больше одного).

Так же было бы неплохо сделать так, чтобы распечатывать наклёпанные документы с задаваемым пользователем количеством копий одним касанием кнопки, а не открывать каждый по отдельности.

И ещё, возможно, ведение базы данных какой тип документа на какую фирму с какими "параметрами замены" создан, кем и когда, отправлен или нет.

Смысл подобного - должно стать больше порядка в делах, ну и плюс то что я за 1-2 дня буду делать то, над чем 7 девушек трудилось по 3 недели.

П.С. По образованию я - не то что не техник или программист, даже не гуманитарий), ничего кроме ВБА не знаю, да и его-то тоже не ахти. Но кроме него больше надежды ни на что нет. Туплю и ламерю так, что иногда самому страшно становится.

[alibek]

Не используй мастер слияния, просто преобразуй документ в документ слияния (включи панель инструментов "Слияние" и настрой главный документ, как "Писмо"). Потом задай источник данных, лучше всего укажи заранее созданный XLS-файл.
Для склонения по падежам можешь поискать мою функцию, когда-то давно я ее выкладывал. Либо написать свою, для тех требований, которые указаны у тебя (по числительным) это десять строчек будет, не больше.

[Bagathur]

Да я по всякому уже мучил мастер слияний - ну не хватает у него возможностей, и всё тут - слишком много переменных в слишком многих файлах требуется менять. Плюс хотелось бы иметь возможность менять всё что угодно по парному списку (что заменить - на что заменить) для любого, пусть даже в 1ый раз видимого файла, и хранить в .txt файле список сделанных замен на всякий случай. Да и не хотелось бы лимитировать количество возможных автозамен - мало ли что там ещё потом будет.

Ночью помучал людей, они подсказали два варианта решения проблемы открытия Вордовских файлов из Экселя:

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

   
  Dim WordApp As New Word.Application
  Dim WordDoc As Word.Document
  Dim CType As String, CFile As String
 
  Dim dirpath As String
  Dim kname As String
  Dim par1 As String
  Dim par2 As String
   
  par1 = ActiveWorkbook.Sheets("Ñïèñîê çàìåíû").Cells(5, 2).Value
  par2 = ActiveWorkbook.Sheets("Ñïèñîê çàìåíû").Cells(5, 3).Value
  dirpath = ActiveWorkbook.Sheets("Ñïèñîê çàìåíû").Cells(63, 2).Value
  fname1 = ActiveWorkbook.Sheets("Ñïèñîê çàìåíû").Cells(64, 2).Value

With WordApp
  .Visible = True
  .WindowState = wdWindowStateMaximize
  CFile = dirpath & "\" & fname1 & ".doc"
  Set WordDoc = .Documents.Open(CFile)
End With

WordDoc.Activate
With WordApp.ActiveDocument.Content.Find
        .Text = par1
        .Replacement.Text = par2
        .Execute Replace:=wdReplaceAll
End With


Только надо подключить в проект Экселя библиотеки Ворда и АктивХ.

2ой вариант ещё проще и изящней - используя функцию OLEOpen, но т.к. я даже примерно не знаю что такое эта OLE, то использую указанный выше, хотя он и длиннее.
Для перевода суммы в пропись скачал надстройку для экселя, добавляющего функцию "СуммаПрописью", так что тут проблем вроде нет.

Следующая стоящая на очереди проблема - создания подобия браузера для жесткого диска, работающего из того же модуля, что и всё остальное. Говоря конкретней:
Есть папка на HDD, содержащая другие файлы и подпапки.
Требуется: пользователь ТОЛЬКО мышкой задаёт путь к папке по дереву (не вводя путь с клавиатуры, дабы не напутал ничего), далее ставит переключатель на количество копий и из указанного каталога распечатываются все файлы (в том числе и из подпапок) с расширениями .doc и .xls указанное количество раз.
Пробовал делать через Dir, заполняя лист-бокс с именами папок программно, но меня убеждают, что есть встроенный в ВБА браузер, да и проблемы с подпапками возникают.

Подскажите плиз что-нибудь путное.

[Bagathur]

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

Sub Кнопка1_Щелкнуть()
Dim She As Variant
Set She = GetObject("path-filename.doc")
She.OLEOpen ActiveSheet.Cells(2, 1), ActiveSheet.Cells(2, 2)
'See.ActiveDocument.Save
End Sub

Function OLEOpen(par1 As String, par2 As String)
    Content.Find.Execute FindText:=par1, ReplaceWith:=par2, Replace:=wdReplaceAll
End Function


вот такой ещё вариант с ОЛЕ

[Bagathur]

Неужели никто не в силах подсказать про браузер файлов в ВБА?
Или хотя бы просто ответить есть он там или нет?)

[GSerg]

В VBA - нет.
В родительском приложении - может быть.
Если это ворд - Application.Dialogs(wdDialogFileOpen).Display
Только это не папка. Папку сам ищи среди констант, но может её там и нет.

[Bagathur]

Угу, нашёл уже)

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

sFilename = Application.GetOpenFilename("All files (*.*), *.*")
' To Exit if Cancel was pressed
If sFilename = False Then Exit Sub

' -- alternatively -- can use

With Application.Dialogs(xlDialogOpen)
    .Show
End With


Вообще много что есть на этом буржуйском сайте - http://www.vba-programmer.com если не знаете ещё.

[Bagathur]

Получается вот такая фигня в теле ЮзерФормы:

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

Dim startdir As String
Private Sub HDD1_Click() 'переключатель для выбора локальных дисков
startdir = "e:\" ' replace with starting directory
Call Список_каталогов
End Sub

Private Sub Список_каталогов()
Dim aryFoundDirectories() As String
Директории.AddItem Application.DefaultFilePath

On Error GoTo NEXT_STEP
' find all directories and subdirs from a starting point
current = 0
dircount = 0
currentdir = startdir
While current <= dircount
    subdirect = Dir(currentdir, vbDirectory + vbHidden)
    While subdirect <> ""
        If subdirect <> "." And subdirect <> ".." Then
            If (GetAttr(currentdir & subdirect) And vbDirectory) = vbDirectory Then
                dircount = dircount + 1
                ReDim Preserve aryFoundDirectories(dircount)
                aryFoundDirectories(dircount) = currentdir & subdirect & "\"
            End If
        End If
        subdirect = Dir
    Wend
    current = current + 1
    currentdir = aryFoundDirectories(current)
Wend
dircount = dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) = startdir
NEXT_STEP:
Браузер.Директории.Clear
For i = 1 To UBound(aryFoundDirectories())
    Браузер.Директории.AddItem aryFoundDirectories(i) 'комбо-бокс для имён каталогов
Next
End Sub

Private Sub Директории_Change() 'Имена файлов
    Dim FileArray() As String, ffile As String, Count As Integer
    Count = 0
    ffile = Dir(Директории.Text, vbDirectory)
    ReDim FileArray(Count)
    FileArray(Count) = LCase(ffile)
    Count = 1
    Do While ffile <> ""
        ffile = Dir()
        If ffile <> "." And ffile <> ". ." Then
            ReDim Preserve FileArray(Count)
            FileArray(Count) = LCase(ffile)
            Count = Count + 1
        End If
    Loop
Браузер.Файлы.Clear
    For i = LBound(FileArray()) To UBound(FileArray())
        Браузер.Файлы.AddItem FileArray(i) 'список для имён файлов
    Next
End Sub


Если где-то получилось слишком тупо и можно заставить работать быстрее-лучше-правильней - подскажите плиз

[Bagathur]

Другой вопрос:
Как удалить из таблицы в документе Word пустые строки?) И строки, начинающиеся на определённый символ?
Таблица одна мелкая, из 12 строк, но заполненных там может быть от 4 до 12.

[GSerg]

Строка таблицы - такой же range, с теми же свойствами типа text и т.д.

[Bagathur]

Ещё проще способ для браузера получился:

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

Sub Список_каталогов()
startdir = Каталоги.Text 'Указывает путь из выбранного комбо-бокса
Папка.Clear
Файлы.Clear
ChDir startdir
MyName = Dir("*.*", vbDirectory) ' Возвращает первый элемент
Do While MyName <> "" ' Начинает цикл
'Игнорирует текущий каталог и каталог предыдущего уровня
If MyName <> "." And MyName <> ".." Then
'Выводит элемент в список каталогов если это каталог
If (GetAttr(startdir & "\" & MyName) And vbDirectory) = vbDirectory Then
Папка.AddItem MyName
'Выводит элемент в список файлов если это файл
ElseIf (GetAttr(startdir & "\" & MyName) And vbNormal) = vbNormal Then
Файлы.AddItem MyName
End If
End If
MyName = Dir 'Возвращает следующий элемент.
Loop
End Sub

[Bagathur]

ГСерг, не подскажешь как отловить где начинается таблица в тексте Word? И как считается количество строк в ней средствами VBA Word-a?

[inq]

Я, конечно, не GSerg, но количетсво строк в таблице - св-во count

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

Tables(i).Rows.Count

[Bagathur]

О, если бы ты был ГСерг-ом, ты бы ответил и на 1ую часть вопроса - как узнать, где в Ворде начинается таблица?)

[GSerg]

Очевидно, как tables(i).range? Наверное так. А скажи, из приведённого кода это правда сложно вывести? Когда начнём читать справку самостоятельно?

[Bagathur]

Просто у меня глаза Excell-ем замылены
И не на всех компах где волею судьбы приходица работать есть справка по VBA. На этом как раз нет.

[Bagathur]

Ещё один небольшой вопрос:
Как поменять курсор мыши с MousePointer = fmMousePointerDefault (0)на MousePointer = 11 в начале выполнения процедуры и вернуть обратно в конце?
Пробовал прописывать смену после Public Sub и перед End Sub - показывает, что значения изменены, но визуально это никак не отображается.
Однако, если прервать выполнение процедуры до команды возврата курсора к обычному виду то на паузе оборажается как раз 11 вариант (песочные часы).
Подскажите плиз в чём тут может быть дело.

[GSerg]

doevents?

[Bagathur]

И ещё один
При попытке открыть уже открытый файл что Ворд, что Эксель выдают диалоговое окно с предупреждением что все изменения будут потеряны.
Можно его как-нибудь обойти программно? Что бы не пользователь жал "да" или "нет", а код VBA отвечал на вопрос?
Запись макроса на этом месте показывает пустое место, ведь никакого действия не выполнено, поиск тоже результатов не принёс.

[GSerg]

Ну если выбранный файл совпадает с одним из открытых, которые ты перебираешь - то наверное?..

[Bagathur]

doevents?

ГСерг, мб другие монстры и мега-программеры VBA с кучей "звёздочек" и поймут это, но лично я 2 недели назад про VBA знал только то, что он есть. Почитал справку, поискал-посмотрел на других ресурсах, но так и не уяснил как это поможет мне решить проблему с видом курсора.
Я неизбежно буду пытаться ещё, если конечно ты не будешь столько любезен и не кинешь хотя бы пару строк "расшифровки".

[GSerg]

MousePointer = fmMousePointerКакойтоТам
doevents

?