powered by simpleCommunicator - 2.0.19     © 2024 Programmizd 02
Map
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Замена изображений в word vba
5 сообщений из 5, страница 1 из 1
Замена изображений в word vba
    #40094858
оуе_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
В бейсике не силен. Не понимаю, в чем ошибка.

Скрипт заменяет картинки в документе на те, которые лежат в папке с соответствующим названием.


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
Sub т111()

Dim inlineshp As InlineShape
Dim inlineshpNew As InlineShape
Dim Altext As String
Dim AFileName As String
Dim APatch As String
'Dim ARange As Range

APatch = "e:\_ISIRServer\"

For Each inlineshp In ActiveDocument.InlineShapes

    Altext = inlineshp.AlternativeText   'запоминаю альтернативный текст

    AFileName = APatch + Altext + ".jpg"   'имя файла
    
    If Dir(AFileName) <> "" Then   'проверяю существует ли файл
        
         ARange = inlineshp.Range
        
        inlineshp.Delete   'удаляю картинку

        'в следующей строке ошибка Несовпадение типа
        Set inlineshpNew = ActiveDocument.InlineShapes.AddPicture(FileName:=AFileName, LinkToFile:=False, SaveWithDocument:=True, Range:=ARange)
        
       
        inlineshpNew.LockAspectRatio = True
        inlineshpNew.AlternativeText = Altext   'возвращаю альтернативный текст
       
       'inlineshpNew.Height = Application.CentimetersToPoints(5)
       'inlineshpNew.Width = Application.CentimetersToPoints(5)
    
    End If

Next inlineshp

End Sub


...
Рейтинг: 0 / 0
Замена изображений в word vba
    #40094923
оуе_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Сделал в delphi

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
procedure TForm2.FormShow(Sender: TObject);
var
  App: OleVariant;
  Doc: OleVariant;
  Pic: OleVariant;
  rng: OleVariant;
  i: Integer;
  ADir, altext: String;
  AFileName: String;
begin
  ADir := ExtractFileDir(Application.ExeName) + '\';
  if not FileExists(ADir + 'name.docx') then close;

  App := CreateOleObject('Word.Application');
  try
    App.Visible := False;
    Doc := App.Documents.open(ADir + 'name.docx');
    App.Selection.MoveRight;
    for i := 1 to Doc.InlineShapes.Count do
    begin
      AFileName := ADir + Doc.InlineShapes[i].AlternativeText + '.jpg';
      If FileExists(AFileName) Then 
      begin
        rng := Doc.InlineShapes.Item[i].Range;
        altext := Doc.InlineShapes[i].AlternativeText;
        Doc.InlineShapes.Item[i].delete;
        Pic := Doc.InlineShapes.AddPicture(AFileName, false, True, rng);
        Pic.AlternativeText := altext;
        Pic.LockAspectRatio := True;
        Pic.Height := 410;
        App.Visible := True;
      end;
    end;
  finally
    // app.Close;
    Doc := Unassigned;
    App := Unassigned;
  end;
  close;
end;




Так и не понял, что не так в vba писал
...
Рейтинг: 0 / 0
Замена изображений в word vba
    #40094926
Eolt
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
оуе_,

Там же написано

Код: vbnet
1.
'в следующей строке ошибка Несовпадение типа
...
Рейтинг: 0 / 0
Замена изображений в word vba
    #40094930
оуе_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Eolt,
А как должно быть?
...
Рейтинг: 0 / 0
Замена изображений в word vba
    #40094951
Eolt
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Наверное как то так

Код: vbnet
1.
   Set inlineshpNew = ActiveDocument.InlineShapes.AddPicture(AFileName, False)
...
Рейтинг: 0 / 0
5 сообщений из 5, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Замена изображений в word vba
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]