Убрать незадействованное пространство у документа Word

@Ципихович Эндрю · Регистрация: 10.04.2009

Студворк — интернет-сервис помощи студентам

здравствуйте при открытии документа Ворд у полотна документа справа до вертикальной прокрутки находится незадействованное пространство шириной 85 мм и слева также находится незадействованное пространство шириной 85 мм – измерял линейкой. Нужно сделать с помощью VBA, чтобы при открытии документа это полотно сдвинулось вправо за 3 мм до вертикальной прокрутки

код должен сдвигать НЕ текст в документе Ворд, то есть поля документа, а я речь веду про пространство справа от границы холста документа до вертикального столбца вертикальной прокрутки
спасибо

@Ципихович Эндрю · 18.06.2024, 11:32 **[ТС]**

потому, что не забываем про

Сообщение от Ципихович Эндрю

условие, если Разрешение экрана: 1920х1080 тогда

тогда масштаб установить 180 - остальные случаи наверное нужно опытным путём проверить, лично у меня ещё есть один монитор, хотя стоп можно тупо на одном мониторе менять разрешение - нужно пробовать))

Сообщение от КостяФедореев

в какой момент запускается код для изменения размеров?

при открытии документа вестимо

@КостяФедореев · 18.06.2024, 12:10

Ципихович Эндрю, попробуйте с этим поиграть

Кликните здесь для просмотра всего текста

Visual Basic
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
41
42
43
44
45
46
47
48
49
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXVSCROLL As Long = 2 ' Ширина вертикальной полосы прокрутки
Private Const SM_CXFRAME As Long = 32 ' Ширина окна рамки
Private Const SM_CXPADDEDBORDER As Long = 92 ' Дополнительная ширина для границы окна (Windows 7 и выше)
Private Const RULER_WIDTH As Long = 50 ' Ширина линейки слева
 
Sub AdjustDocumentWidth()
    Dim screenWidth As Long
    Dim screenHeight As Long
    Dim documentWidthPoints As Double
    Dim documentWidthPixels As Double
    Dim pointsToPixels As Double
    Dim targetZoom As Double
    Dim windowExtraWidth As Long
    Dim internalWidth As Long
    Dim frameExtraWidth As Long
    Dim borderExtraWidth As Long
    Dim vscrollWidth As Long
 
    ' Получить разрешение экрана
    screenWidth = GetSystemMetrics(0) ' M_CXSCREEN - ширина экрана
    screenHeight = GetSystemMetrics(1) ' M_CYSCREEN - высота экрана
 
    Select Case screenWidth
        Case 1920
            targetZoom = 180
        Case 2560
            targetZoom = 220
        Case Else
            targetZoom = 100 ' по умолчанию масштаб 100%, если разрешение экрана не совпадает
    End Select
 
    ActiveDocument.ActiveWindow.View.Zoom.Percentage = targetZoom
 
    documentWidthPoints = ActiveDocument.PageSetup.PageWidth
 
    documentWidthPixels = documentWidthPoints * (targetZoom / 100)
 
    vscrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    frameExtraWidth = GetSystemMetrics(SM_CXFRAME) * 2
    borderExtraWidth = GetSystemMetrics(SM_CXPADDEDBORDER) * 2
    windowExtraWidth = vscrollWidth + frameExtraWidth + borderExtraWidth + RULER_WIDTH
 
    ActiveWindow.Width = documentWidthPixels + windowExtraWidth
    
    MsgBox "Разрешение экрана: " & screenWidth & "x" & screenHeight & " пикселей" & vbCrLf & _
           "Новый масштаб документа: " & targetZoom & "%" & vbCrLf & _
           "Новая ширина окна: " & ActiveWindow.Width & " пикселей"
End Sub

@Ципихович Эндрю · 18.06.2024, 13:05 **[ТС]**

КостяФедореев, у меня ошибка 5868=Окно развёрнуто, на предпоследней строке кода:

PureBasic
1
ActiveWindow.Width = documentWidthPixels + windowExtraWidth

думаю то что я изменил в начале кода под себя, под ворд 2007 ни при чём))

PureBasic
1
2
3
'в ворде 2007 НЕ работает Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'работает в ворде 2007
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

@КостяФедореев · 18.06.2024, 13:22

Ципихович Эндрю, добавьте перед строкой с ошибкой

Visual Basic
1
2
3
If ActiveWindow.WindowState = wdWindowStateMaximize Then
        ActiveWindow.WindowState = wdWindowStateNormal
    End If

@Ципихович Эндрю · 18.06.2024, 13:44 **[ТС]**

КостяФедореев, спасибо за помощь, пока имею:

Visual Basic
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
41
42
43
44
45
46
47
48
49
50
Option Explicit
 
'в ворде 2007 НЕ работает Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'работает в ворде 2007
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXVSCROLL As Long = 2 ' Ширина вертикальной полосы прокрутки
Private Const SM_CXFRAME As Long = 32 ' Ширина окна рамки
Private Const SM_CXPADDEDBORDER As Long = 92 ' Дополнительная ширина для границы окна (Windows 7 и выше)
Private Const RULER_WIDTH As Long = 50 ' Ширина линейки слева
 
Sub Document_Open()
 
    'MsgBox$ "Работает макрос: Private Sub Document_Open()"
    Dim screenWidth As Long
    Dim screenHeight As Long
    Dim documentWidthPoints As Double
    Dim documentWidthPixels As Double
    Dim pointsToPixels As Double
    Dim targetZoom As Double
    Dim windowExtraWidth As Long
    Dim internalWidth As Long
    Dim frameExtraWidth As Long
    Dim borderExtraWidth As Long
    Dim vscrollWidth As Long
    'получить разрешение экрана
    screenWidth = GetSystemMetrics(0) ' M_CXSCREEN - ширина экрана
    screenHeight = GetSystemMetrics(1) ' M_CYSCREEN - высота экрана
    Select Case screenWidth
        Case 1920
            targetZoom = 180
        Case 2560
            targetZoom = 220
        Case Else
            targetZoom = 100 'по умолчанию масштаб 100%, если разрешение экрана не совпадает
    End Select
    ActiveDocument.ActiveWindow.View.Zoom.Percentage = targetZoom
    documentWidthPoints = ActiveDocument.PageSetup.PageWidth
    documentWidthPixels = documentWidthPoints * (targetZoom / 100)
    vscrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    frameExtraWidth = GetSystemMetrics(SM_CXFRAME) * 2
    borderExtraWidth = GetSystemMetrics(SM_CXPADDEDBORDER) * 2
    windowExtraWidth = vscrollWidth + frameExtraWidth + borderExtraWidth + RULER_WIDTH
    If ActiveWindow.WindowState = wdWindowStateMaximize Then
        ActiveWindow.WindowState = wdWindowStateNormal
    End If
    ActiveWindow.Width = documentWidthPixels + windowExtraWidth
    'MsgBox "Разрешение экрана: " & screenWidth & "x" & screenHeight & " пикселей" & vbCrLf & _
           "Новый масштаб документа: " & targetZoom & "%" & vbCrLf & _
           "Новая ширина окна: " & ActiveWindow.Width & " пикселей" '1155
End Sub

подскажите, как узнать версию ворда я знаю ну а как её указывать - имеется ввиду ставит условие при декларировании то есть вне макроса ХЗ, как?

Python
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim version As String
    version = Application.version
    Select Case version
        Case "12.0"
            'MsgBox$ "Версия Office 2007"
            по идее сюда нужно, как?
        Case "14.0"
            MsgBox$ "Версия Office 2010"
        Case "15.0"
            MsgBox$ "Версия Office 2013"
        Case "16.0"
            MsgBox$ "Версия Office 2016"
        Case Else
            MsgBox$ "Версия Office неизвестна"
    End Select

2
как бы сделать, чтобы высота окна документа ворд была на всю высоту монитора, сейчас где-то на половину
3
как сделать чтобы правый верхний угол окна документа ворд и монитора совпадали? - пока не так
4
как сделать, чтобы это было плавно без прыжков - как будто майкрософт это сделал))
спасибо

@КостяФедореев · 18.06.2024, 15:13

Ципихович Эндрю, насчет последнего, вряд ли такое можно сделать, только если отключить обновление экрана

Кликните здесь для просмотра всего текста

Visual Basic
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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
 
Private Const SM_CXVSCROLL As Long = 2 ' Ширина вертикальной полосы прокрутки
Private Const SM_CXFRAME As Long = 32 ' Ширина окна рамки
Private Const SM_CXPADDEDBORDER As Long = 92 ' Дополнительная ширина для границы окна (Windows 7 и выше)
Private Const RULER_WIDTH As Long = 50 ' Ширина линейки слева
Private Const TASKBAR_HEIGHT As Long = 40 ' Высота панели задач (фиксированное значение)
Private Const SM_CYCAPTION As Long = 4 ' Высота заголовка окна
Private Const SM_CYFRAME As Long = 33 ' Высота рамки окна
Private Const HWND_TOP As Long = 0
 
Sub AdjustDocumentWindow()
    Dim screenWidth As Long
    Dim screenHeight As Long
    Dim documentWidthPoints As Double
    Dim documentWidthPixels As Double
    Dim targetZoom As Double
    Dim windowExtraWidth As Long
    Dim frameExtraWidth As Long
    Dim borderExtraWidth As Long
    Dim vscrollWidth As Long
    Dim captionHeight As Long
    Dim frameExtraHeight As Long
    Dim hwnd As Long
 
    ' Получить разрешение экрана
    screenWidth = GetSystemMetrics(0) ' SM_CXSCREEN - ширина экрана
    screenHeight = GetSystemMetrics(1) ' SM_CYSCREEN - высота экрана
 
    ' Установить целевой масштаб в зависимости от разрешения экрана
    Select Case screenWidth
        Case 1920
            targetZoom = 180
        Case 2560
            targetZoom = 180
        Case Else
            targetZoom = 100 ' по умолчанию масштаб 100%, если разрешение экрана не совпадает
    End Select
 
    ActiveDocument.ActiveWindow.View.Zoom.Percentage = targetZoom
 
    documentWidthPoints = ActiveDocument.PageSetup.PageWidth
 
    documentWidthPixels = documentWidthPoints * (targetZoom / 100)
 
    vscrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    frameExtraWidth = GetSystemMetrics(SM_CXFRAME) * 2
    borderExtraWidth = GetSystemMetrics(SM_CXPADDEDBORDER) * 2
    captionHeight = GetSystemMetrics(SM_CYCAPTION)
    frameExtraHeight = GetSystemMetrics(SM_CYFRAME) * 2
    windowExtraWidth = vscrollWidth + frameExtraWidth + borderExtraWidth + RULER_WIDTH
 
    If ActiveWindow.WindowState = wdWindowStateMaximize Then
        ActiveWindow.WindowState = wdWindowStateNormal
    End If
 
    hwnd = FindWindow("OpusApp", vbNullString)
    If hwnd = 0 Then
        MsgBox "Не удалось получить дескриптор окна Word."
        Exit Sub
    End If
 
    Dim newHeight As Long
    newHeight = screenHeight - TASKBAR_HEIGHT
 
    Dim newWidth As Long
    newWidth = (documentWidthPixels + windowExtraWidth) * 1.333
 
    SetWindowPos hwnd, HWND_TOP, 0, 0, newWidth, newHeight, SWP_NOSIZE
    MsgBox "Разрешение экрана: " & screenWidth & "x" & screenHeight & " пикселей" & vbCrLf & _
           "Новый масштаб документа: " & targetZoom & "%" & vbCrLf & _
           "Новая высота окна: " & newHeight & " пикселей" & vbCrLf & _
           "Новая ширина окна: " & newWidth & " пикселей"
End Sub

@Ципихович Эндрю · 18.06.2024, 15:30 **[ТС]**

спасибо, у меня в строке

Visual Basic
1
SetWindowPos hwnd, HWND_TOP, 0, 0, newWidth, newHeight, SWP_NOSIZE

ругнулось на SWP_NOSIZE - как исправить?

@КостяФедореев · 18.06.2024, 15:35

Ципихович Эндрю, Заменить на

Visual Basic
1
    SetWindowPos hwnd, HWND_TOP, 0, 0, newWidth, newHeight, SWP_NOZORDER

вверху добавить константу

Visual Basic
1
Private Const SWP_NOZORDER As Long = &H4

Добавлено через 2 минуты
Вот список некоторых других флагов, которые могут использоваться с функцией SetWindowPos:

SWP_NOSIZE (&H1): Не изменяет размеры окна.
SWP_NOMOVE (&H2): Не изменяет позицию окна.
SWP_NOZORDER (&H4): Не изменяет порядок Z-порядка окна.
SWP_NOREDRAW (&H8): Не перерисовывает окно.
SWP_NOACTIVATE (&H10): Не активирует окно.
SWP_FRAMECHANGED (&H20): Принудительно устанавливает кадр окна, даже если размер не изменился.
SWP_SHOWWINDOW (&H40): Отображает окно.
SWP_HIDEWINDOW (&H80): Скрывает окно.
SWP_NOCOPYBITS (&H100): Удаляет содержимое клиентской области.
SWP_NOOWNERZORDER (&H200): Не изменяет Z-порядок владельца.

@Ципихович Эндрю · 18.06.2024, 15:53 **[ТС]**

КостяФедореев, напутали

Сообщение от Ципихович Эндрю

как сделать чтобы правый верхний угол окна документа ворд и монитора совпадали?

а вы сделали левый, в принципе тоже интересно, как сделать переключение с левого как сейчас - на правый?

@КостяФедореев · 18.06.2024, 16:04

Ципихович Эндрю,
замените

Visual Basic
1
SetWindowPos hwnd, HWND_TOP, screenWidth - newWidth, 0, newWidth, newHeight, SWP_NOZORDER

Добавлено через 4 минуты
SetWindowPos
(
HWND hWnd, // дескриптор окна
HWND hWndInsertAfter, // дескриптор порядка размещения
int X, // позиция по горизонтали
int Y, // позиция по вертикали
int cx, // ширина
int cy, // высота
UINT uFlags // флажки позиционирования окна писал про них выше
);

@Ципихович Эндрю · 18.06.2024, 16:22 **[ТС]**

КостяФедореев, увы НЕ помогло:

Visual Basic
1
2
'SetWindowPos hwnd, HWND_TOP, 0, 0, newWidth, newHeight, SWP_NOZORDER ' расположить окно документа слева
    SetWindowPos hwnd, HWND_TOP, screenWidth - newWidth, 0, newWidth, newHeight, SWP_NOZORDER ' расположить окно документа справа

@КостяФедореев · 18.06.2024, 16:40

Ципихович Эндрю, должно все работать.
у меня по правой части экрана выравнивается.

Или я не понимаю, что вы от меня хотите))

@Ципихович Эндрю · 19.06.2024, 09:33 **[ТС]**

КостяФедореев, посмотрите пожалуйста два файла, там код вписан в Document_Open так, что сработает при открытии, и они оба при открытии упорно показывают окно справа, а должны справа\слева

@КостяФедореев · 19.06.2024, 10:18

Ципихович Эндрю, при открытии код срабатывает раньше чем полностью прогрузится Application
поменял подход, добавил класс, который отслеживает загрузку Application и потом запускает макрос.

P.S. не нужно комментировать декларации которые у Вас подсвечиваются красным, так и должно быть, там они написаны для х32 и х64 и код сам выбирает какие ему нужны

@Ципихович Эндрю · 19.06.2024, 12:57 **[ТС]**

Сообщение от КостяФедореев

P.S. не нужно комментировать декларации которые у Вас подсвечиваются красным, так и должно быть, там они написаны для х32 и х64 и код сам выбирает какие ему нужны

не знал такое - спасибо
посмотрю результат, ещё раз спасибо

Добавлено через 2 часа 29 минут
КостяФедореев,

Сообщение от Ципихович Эндрю

посмотрю результат

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

@КостяФедореев · 19.06.2024, 14:19

Сообщение от Ципихович Эндрю

можно разместить окно с нужным

что это за окно? тоже word?

Сообщение от Ципихович Эндрю

эти окна были "склеены"

что это значит?

@Ципихович Эндрю · 19.06.2024, 14:26 **[ТС]**

Сообщение от КостяФедореев

что это за окно? тоже word?

да ворд, примерно так- GUI применять с использованием html то, что вы любезно подсказали
ну склеены - значит одно окно

@КостяФедореев · 19.06.2024, 14:32

Ципихович Эндрю, вы имеете ввиду:
открыть ворд с выравниванием справа, а юзерфоррм привязать слева в плотную к ворду?

@Ципихович Эндрю · 19.06.2024, 14:35 **[ТС]**

КостяФедореев, нет, не вплотную а, чтобы это было одно окно = "приклеить"

@КостяФедореев · 19.06.2024, 14:46

Ципихович Эндрю, тут простым VBA не обойтись, надо писать плагин для этого.
Вы помните, что она будет работать только в офисе выше 2013(включительно) версии
а что там в этом окне будет? Кнопки?

если будет время попробую написать, но не обещаю.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Nekobox - outbounds[0].transport: unknown transport type: raw damix 01.10.2026 Фикс ошибки Правым кликом по серверу -> отладочная информация -> edit Заменить "net": "raw", на "net": "tcp", Нажать кнопку reload.
Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .

@Ципихович Эндрю 1713 / 580 / 76 Регистрация: 10.04.2009 Сообщений: 9,337

	Убрать незадействованное пространство у документа Word 07.05.2024, 08:59. Показов 2892. Ответов 46 Метки нет (Все метки) здравствуйте при открытии документа Ворд у полотна документа справа до вертикальной прокрутки находится незадействованное пространство шириной 85 мм и слева также находится незадействованное пространство шириной 85 мм – измерял линейкой. Нужно сделать с помощью VBA, чтобы при открытии документа это полотно сдвинулось вправо за 3 мм до вертикальной прокрутки код должен сдвигать НЕ текст в документе Ворд, то есть поля документа, а я речь веду про пространство справа от границы холста документа до вертикального столбца вертикальной прокрутки спасибо 0

@КостяФедореев Часто онлайн 987 / 637 / 280 Регистрация: 09.01.2017 Сообщений: 2,080
	18.06.2024, 16:40
	Ципихович Эндрю, должно все работать. у меня по правой части экрана выравнивается. Или я не понимаю, что вы от меня хотите)) 0

@КостяФедореев Часто онлайн 987 / 637 / 280 Регистрация: 09.01.2017 Сообщений: 2,080
	19.06.2024, 14:32
	Ципихович Эндрю, вы имеете ввиду: открыть ворд с выравниванием справа, а юзерфоррм привязать слева в плотную к ворду? 0

@Ципихович Эндрю 1713 / 580 / 76 Регистрация: 10.04.2009 Сообщений: 9,337
	19.06.2024, 14:35 [ТС]
	КостяФедореев, нет, не вплотную а, чтобы это было одно окно = "приклеить" 0

@КостяФедореев Часто онлайн 987 / 637 / 280 Регистрация: 09.01.2017 Сообщений: 2,080
	19.06.2024, 14:46
	Ципихович Эндрю, тут простым VBA не обойтись, надо писать плагин для этого. Вы помните, что она будет работать только в офисе выше 2013(включительно) версии а что там в этом окне будет? Кнопки? если будет время попробую написать, но не обещаю. 0