Вопрос по VBS скриптам (Excel и Word)

[Буржуй]

Такой вопрос:

есть такой VBS файл скрипта.

Const xlFrmt = 56 'Если у вас Excel 2010
with CreateObject("Excel.Application")
.DisplayAlerts =False
.WorkBooks.Open(WScript.Arguments(0)).SaveAs WScript.Arguments(0),xlFrmt
.quit
end with

он сохраняет текущий файл в формат 2010 Excel
надо тоже самое для ворда


смысл вот в чем, есть файл пример.doc, в нем текст неформатированный, то есть реально ето бывший txt файл. Надо его открыть, поменять шрифт на курьер нью, размер шрифта на 8, поля страницы со всех сторон 1 см, и сохранить файл с тем же именем в формате 2010 ворда.

подскажет кто?

 

[amper]

можно я тут тоже постою в уголке, послушаю)
нужен простой файл для конвертирования в xlsx и docx старых xls,doc

 

[Буржуй]

можно я тут тоже постою в уголке, послушаю)
нужен простой файл для конвертирования в xlsx и docx старых xls,doc

по xls - вот тебе скрипт вверху. только не заменит расширение. а так все будет новое... Мне надо для ворда...)

 

[evn]

только 2007 нужен

 

[Uncle_RS]

Нужен код непосредственно в VBS? Или достаточно VBA для ворда? На работе ворд не установлен, поэтому потестировать не могу, под эксель похожий код есть - открывает подряд все файлы в папке. Действия с файлами прописываются отдельно.
Дома покопаюсь в ворде.
В экселе как-то так:

Спойлер

Workbooks("Имя файла с макросом.xls").Sheets("Стартовая").Activate
ChDir file_path
myname = Dir(file_path + "\", vbDirectory)
'выводим список файлов в столбец
Do While myname <> ""
' Игнорировать название файла с макросами и точки
If myname <> "." And myname <> ".." Then
i = i + 1
Cells(i, 100).Value = myname
End If
myname = Dir ' Get next entry.
Loop
Dim file_name As String
For jj = 1 To i
Application.StatusBar = "Осталось " & (i - jj) & " файла(ов)"
file_name = Workbooks("имя файла с макросом.xls").Sheets("Стартовая").Cells(jj, 100).Value
'запуск подпрограммы, переносящей данные
qwerty = название_функции_описывающей_что_делать_с_файлом(file_name)
Workbooks(file_name).Close False
Next jj

upd: file_path - путь к файлам, которые нужно обработать, можно либо прописать как константу, либо сделать диалоговое окно

 

[!Chip]

можно я тут тоже постою в уголке, послушаю)
нужен простой файл для конвертирования в xlsx и docx старых xls,doc

Тебе нужно просто файлы конвертировать или в 2003 офисе открывать docx ?

 

[evn]

нужен простой файл для конвертирования в xlsx и docx старых xls,doc

<code>Option Explicit ' Convert all xls files in selected folder to xlsx Sub convertXLStoXLSX() Dim FSO As Scripting.FileSystemObject Dim strConversionPath As String Dim fFile As File Dim fFolder As Folder Dim wkbConvert As Workbook ' Open dialog and select folder With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show strConversionPath = .SelectedItems(1) End With Set FSO = New Scripting.FileSystemObject ' Check if the folder exists If FSO.FolderExists(strConversionPath) Then Set fFolder = FSO.GetFolder(strConversionPath) ' Loop through files, find the .xls files For Each fFile In fFolder.Files If Right(fFile.Name, 4) = ".xls" Then Application.DisplayAlerts = False wkbConvert = Workbooks.Open(fFile.Path) ' Save as XML workbook - if file contains macros change FileFormat:=52 wkbConvert.SaveAs FSO.BuildPath(fFile.ParentFolder, Left(fFile.Name, Len(fFile.Name) - 4)) & ".xlsx", FileFormat:=51 wkbConvert.Close SaveChanges:=False ' Delete original file fFile.Delete Force:=True Application.DisplayAlerts = True End If Next fFile End If End Sub</code></pre>

на оффсайте

 

[Буржуй]

Нужен код непосредственно в VBS? Или достаточно VBA для ворда? На работе ворд не установлен, поэтому потестировать не могу, под эксель похожий код есть - открывает подряд все файлы в папке. Действия с файлами прописываются отдельно.
Дома покопаюсь в ворде.

Получилось вот что на самом деле:

Const wdFormatText = 14


Set objWord = CreateObject("Word.Application")
objWord.Visible = FALSE
Set objDoc = objWord.Documents.Open(WScript.Arguments(0))
objDoc.SaveAs WScript.Arguments(0), wdFormatText


objWord.Quit

Но это не все. Надо отформатировать то что мы сохраняем. И вот КУДА конкретно ето вставить?

.Font.Name = "Courier New"
.Font.Size = 8
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)

 

[evn]

Set objWord = CreateObject("Word.Application")

objSelection.Font.Name = "Courier New"
objSelection.Font.Size = "8"

With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)
End With

 

[Буржуй]

Set objWord = CreateObject("Word.Application")

objSelection.Font.Name = "Courier New"
objSelection.Font.Size = "8"

With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)
End With

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

 

[Буржуй]

Нужен код непосредственно в VBS? Или достаточно VBA для ворда? На работе ворд не установлен, поэтому потестировать не могу, под эксель похожий код есть - открывает подряд все файлы в папке. Действия с файлами прописываются отдельно.
Дома покопаюсь в ворде.
В экселе как-то так:

Спойлер

Workbooks("Имя файла с макросом.xls").Sheets("Стартовая").Activate
ChDir file_path
myname = Dir(file_path + "\", vbDirectory)
'выводим список файлов в столбец
Do While myname <> ""
' Игнорировать название файла с макросами и точки
If myname <> "." And myname <> ".." Then
i = i + 1
Cells(i, 100).Value = myname
End If
myname = Dir ' Get next entry.
Loop
Dim file_name As String
For jj = 1 To i
Application.StatusBar = "Осталось " & (i - jj) & " файла(ов)"
file_name = Workbooks("имя файла с макросом.xls").Sheets("Стартовая").Cells(jj, 100).Value
'запуск подпрограммы, переносящей данные
qwerty = название_функции_описывающей_что_делать_с_файлом(file_name)
Workbooks(file_name).Close False
Next jj

upd: file_path - путь к файлам, которые нужно обработать, можно либо прописать как константу, либо сделать диалоговое окно

мягко говоря не то. выше написал что надо)

 

[Uncle_RS]

Пока танки обновлялись набросал что-то

Спойлер

Sub test1()
Dim file_path As String, z(100) As Variant
Const cur_book = "test"
file_path = "D:\test"
ChDir file_path
myname = Dir(file_path + "\", vbDirectory)
Windows(cur_book).Activate
Do While myname <> ""
' Игнорировать название файла с макросами и точки
If myname <> "." And myname <> ".." And myname <> cur_book + ".doc" Then
i = i + 1
Selection.TypeText Text:=myname + Chr(10)
End If
myname = Dir ' Get next entry.
Loop

For qq = 1 To i
Windows(cur_book).Activate
ActiveDocument.Paragraphs(qq).Range.Select
bk2open = Selection.Text
new_nam = file_path + "\" + Left(bk2open, Len(bk2open) - 1)
Documents.Open FileName:=new_nam
Windows(bk2open).Activate
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
Selection.PageSetup.LeftMargin = CentimetersToPoints(1)
Selection.PageSetup.RightMargin = CentimetersToPoints(1)
Selection.PageSetup.TopMargin = CentimetersToPoints(1)
Selection.PageSetup.BottomMargin = CentimetersToPoints(1)
ActiveDocument.Close SaveChanges:=True
Next qq
End Sub

Создать вордовский документ, открыть редактор макросов, вставить модуль, в модуль вставить текст под спойлером и подкорректировать.
Это имя вордовского файла с макросом:
Const cur_book = "test"
Это путь к папке, в которой лежат исходные файлы
file_path = "D:\test"
Макрос после обработки файлы сохраняет без запроса, поэтому лучше сделать резервную копию.

ЗЫ Ногами не бить, первый раз в ВБА для ворда пишу

 

[Uncle_RS]

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

мб перед objSelection.Font.Name = "Courier New"
вписать objSelection.wholestory ?

Со скриптами не дружу

 

[Буржуй]

мб перед objSelection.Font.Name = "Courier New"
вписать objSelection.wholestory ?

Со скриптами не дружу

получился пустой файл.

 

[Буржуй]

Set objWord = CreateObject("Word.Application")

objSelection.Font.Name = "Courier New"
objSelection.Font.Size = "8"

With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)
End With

это вообще не работает.

 

[evn]

это вообще не работает.

txt 2 doc работает?

ConfirmConversions:=True добавь.</pre>

 

[Буржуй]

txt 2 doc работает?

ConfirmConversions:=True добавь.

бред.

Что получилось:

Const wdFormatText = 14
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(WScript.Arguments(0))
With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)
End With
objDoc.SaveAs WScript.Arguments(0), wdFormatText
objWord.Quit
Set objWord = Nothing

это работает. поменялись поля как надо, все ок.

Что надо: весь текст
objSelection.Font.Name = "Courier New"
objSelection.Font.Size = "8"

 

[evn]

Ч

Const wdFormatText = 14
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(WScript.Arguments(0))
With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(1)
.BottomMargin = objWord.CentimetersToPoints(1)
.LeftMargin = objWord.CentimetersToPoints(1)
.RightMargin = objWord.CentimetersToPoints(1)
End With
objDoc.SaveAs WScript.Arguments(0), wdFormatText
objWord.Quit
Set objWord = Nothing

это работает. поменялись поля как надо, все ок.

Что надо: весь текст
obj<code>Word</code>Selection.Font.Name = "Courier New"
obj<code>Word</code>Selection.Font.Size = "8"

вроде так
если не заработает, указывай область в начале скрипта


Set objRange = objDoc.Range()
objRange.Font.Name = "Courier New"
objRange.Font.Size = 8

 

[Буржуй]

Заработало. Общими советами.

Const wdFormatText = 14

Set objWord = CreateObject("Word.Application")




Set objDoc = objWord.Documents.Open(WScript.Arguments(0))
With objWord.ActiveDocument.PageSetup
.LineNumbering.Active = False
.TopMargin = objWord.CentimetersToPoints(0.3)
.BottomMargin = objWord.CentimetersToPoints(0.3)
.LeftMargin = objWord.CentimetersToPoints(0.7)
.RightMargin = objWord.CentimetersToPoints(0.7)
End With
Set oSel = objWord.Selection
With osel
.WholeStory
.Font.Name = "Courier New"
.Font.Size = "8"
End With


objDoc.SaveAs WScript.Arguments(0), wdFormatText
objWord.Quit
Set objWord = Nothing

 

[Буржуй]

Всем спасибо