1 Тема от giaber

  • giaber
  • рядовой
  • Неактивен
  • Зарегистрирован: 06.06.2015
  • Сообщений: 8
  • Поблагодарили: 1

Тема: Файлы mht сохранить как docx

Здравствуйте !
Очень нужны такие вот 2 макроса (Word 2007):

1. В Word-e открыты несколько документов формата mht. Нужен макрос, который сохранит эти документы с тем же названием в формате docx в те же директории, в которых находятся оригинальные mht файлы  и закроет документ(ы).

2. В Word-e открыт документ формата mht. Нужен макрос, который сохранит выделеную мышкой часть документа  с тем же названием в формате docx в ту же директорию, в которой находится оригинальный mht файл и закроет документ(ы).

Скачал с форумов несколько макросов связанных с сохранением, пытался скомбинировать что-то работающее, но безуспешно. Не могли бы вы помочь? Спасибо!

2 Ответ от giaber

  • giaber
  • рядовой
  • Неактивен
  • Зарегистрирован: 06.06.2015
  • Сообщений: 8
  • Поблагодарили: 1

Re: Файлы mht сохранить как docx

Удалось самому решить 2ю задачу. Вот макрос,уродливый конечно,но работает:

Sub CopyFromMhtAndSaveSelectionAsDocx()

' сохраняет как Word-документ выделеный в открытом .mht-файле блок (включая рисунки), 

' папка сохранения и название те же что у MHT файла

 

docpath = ActiveDocument.Path ' путь MHT файла
docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3)' название MHT файла без расширения (точка остаётся)

 

Selection.Copy ' копируем нужное из MHT файла


ActiveWindow.Close ' закрываем  MHT файл, так как Word не допускает сохранение с названием открытого файла (у меня так)


 

Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 ' создаём новый Word-документ

Selection.PasteAndFormat (wdPasteDefault) ' вставка скопированного в новый документ

 

ChangeFileOpenDirectory docpath ' задаём путь для сохранения

' сохраняем с именем docname и прибавлением расширения "docx":

ActiveDocument.SaveAs FileName:=docname & "docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
    
ActiveWindow.Close ' закрываем  "docx" файл
   
End Sub

С первой задачкой пока никак не могу справиться-так что просьба о помощи остаётся актуальной

3 Ответ от giaber

  • giaber
  • рядовой
  • Неактивен
  • Зарегистрирован: 06.06.2015
  • Сообщений: 8
  • Поблагодарили: 1

Re: Файлы mht сохранить как docx

Удалось всё же самому решить и 1ю задачу. Конечно, коряво, но в итоге работает:

Sub SaveAllOpenedMhtAsDocx()
For i = Documents.Count To 1 Step -1
docpath = ActiveDocument.Path
docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx"

ChangeFileOpenDirectory docpath
ActiveDocument.SaveAs FileName:=docname, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Next
End Sub

Можно считать что тема закрыта, хотя было бы неплохо, если бы кто-нибудь выложил более профессиональный код

4 Ответ от giaber

  • giaber
  • рядовой
  • Неактивен
  • Зарегистрирован: 06.06.2015
  • Сообщений: 8
  • Поблагодарили: 1
  • За сообщение: 1

Re: Файлы mht сохранить как docx

немного доработаный вариант. Вроде работает нормально:    

Sub SaveAllOpenedMhtAsDocx()
For i = Documents.Count To 1 Step -1
    docpath = ActiveDocument.Path ' путь MHT файла
    docname = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 3) & "docx"
    ChangeFileOpenDirectory docpath
    ActiveDocument.SaveAs docname, wdFormatXMLDocument
    ActiveWindow.Close
Next i
End Sub