Вставка рисунка в угол страницы

[7bit]

Добрый день! В Writer я хочу вставить рисунок в левый верхний угол первой страницы без учета полей. Написал на пару с ИИ такой код:

Код Выделить Развернуть

REM  *****  BASIC  *****
Option VBASupport 1

Sub InsertImageIntoCornerDocument

  Dim oDoc, oDrawPage, oGraphic As Object
  Dim aSize As New com.sun.star.awt.Size
  Dim ImagePath
  Dim aOriginalSize As Object

  ImagePath = "/home/user/Изображения/admin_krai_logo.png"
  oDoc = ThisComponent

  ' Определяем первую страницу документа
  oDrawPage = oDoc.DrawPages(0)

  ' Добавляем графический объект на первый слой
  oGraphic = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")


  aOriginalSize = GetImageSizePixels( ConvertToURL(ImagePath) )
   
  ' Устанавливаем свойства для точного позиционирования
  With oGraphic
    .GraphicURL = ConvertToURL(ImagePath)
    ' Привязка к странице
    .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
       
    ' Обтекание "на фоне"
    .TextWrap = com.sun.star.text.WrapTextMode.THROUGH
       
    ' Точное позиционирование
    .HoriOrient = com.sun.star.text.HoriOrientation.NONE
    .VertOrient = com.sun.star.text.VertOrientation.NONE
       
    ' Позиция точно в углу страницы
    .HoriOrientPosition = 0
    .VertOrientPosition = 0
       
    ' Относительно страницы, а не полей
    .HoriOrientRelation = com.sun.star.text.RelOrientation.PAGE_FRAME
    .VertOrientRelation = com.sun.star.text.RelOrientation.PAGE_FRAME
       
    .SetSize(aOriginalSize)

  End With

  ' Добавляем объект на страницу
  oDrawPage.add(oGraphic)

End Sub

Function GetImageSizePixels(sImagePath As String) As Object

  Dim oGraphicProvider As Object
  Dim aMediaProperties(0) As New com.sun.star.beans.PropertyValue
  Dim oGraphic As Object
  Dim aSize As New com.sun.star.awt.Size
   
  ' Создаем провайдер графики
  oGraphicProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider")
   
  ' Настраиваем параметры
  aMediaProperties(0).Name = "URL"
  aMediaProperties(0).Value = sImagePath
   
  ' Загружаем и получаем размер в пикселях
  oGraphic = oGraphicProvider.queryGraphic(aMediaProperties())
   
  GetImageSizePixels = oGraphic.Size
End Function
Проблема в том, что картинка вставляется очень маленькая. Я понимаю, что это из-за того, что единица измерения сотые доли миллиметра. Но как правильно преобразовать размер изображения, чтобы он соответствовал оригинальному изображению на экране я не знаю.

[sokol92]

Квалификация нейросетей растет на глазах, но мы еще не всему их научили.

Лучше для загрузки изображения сразу использовать GraphicProvider. Одно из свойств Size100thMM полученного объекта как раз и отвечает за искомый размер.
Вот минимально переделанный Ваш макрос - проверьте.

Код Выделить Развернуть

Sub InsertImageIntoCornerDocument
  Dim oDoc as Object, oDrawPage as Object, oShape as Object, oGraphic As Object
  Dim aSize As New com.sun.star.awt.Size
  Dim ImagePath
  Dim aOriginalSize As Object

  ImagePath = "/home/user/Изображения/admin_krai_logo.png"
  'ImagePath = "C:\Temp\2025-09-14 161709.png"
  oDoc = ThisComponent

  oDrawPage = oDoc.DrawPages(0)
  oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
     
  ' Устанавливаем свойства для точного позиционирования
  With oShape
    .Graphic = GetGraphicByUrl(ImagePath)
   
    ' Привязка к странице
    .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
       
    ' Обтекание "на фоне"
    .TextWrap = com.sun.star.text.WrapTextMode.THROUGH
       
    ' Точное позиционирование
    .HoriOrient = com.sun.star.text.HoriOrientation.NONE
    .VertOrient = com.sun.star.text.VertOrientation.NONE
       
    ' Позиция точно в углу страницы
    .HoriOrientPosition = 0
    .VertOrientPosition = 0
       
    ' Относительно страницы, а не полей
    .HoriOrientRelation = com.sun.star.text.RelOrientation.PAGE_FRAME
    .VertOrientRelation = com.sun.star.text.RelOrientation.PAGE_FRAME
       
    .SetSize(.Graphic.Size100thMM)

  End With

  ' Добавляем объект на страницу
  oDrawPage.add(oShape)

End Sub

Function GetGraphicByUrl(sImagePath As String) As Object
  Dim oGraphicProvider As Object
  Dim aMediaProperties(0) As New com.sun.star.beans.PropertyValue
  Dim oGraphic As Object
   
  ' Создаем провайдер графики
  oGraphicProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider")
  ' Настраиваем параметры
  aMediaProperties(0).Name = "URL"
  aMediaProperties(0).Value = ConvertToUrl(sImagePath)
  GetGraphicByUrl = oGraphicProvider.queryGraphic(aMediaProperties())
End Function

[7bit]

Спасибо! Вы мне очень помогли.