Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

VBAtips.ru - подсказки и решения на VBA


Быстрое перемещение между открытыми документами Word

Если у вас открыто несколько документов Word, с которыми вы одновременно работаете, то для перемещения между ними можно использовать сочетания клавиш «Ctrl»+«F6» или «Shift»+«Ctrl»+«F6».
Сочетание «Ctrl»+«F6» позволяет перемещаться от самого последнего созданного документа (по времени) к первому (в обратном порядке), в то время как сочетание «Shift»+«Ctrl»+«F6» позволяет перемещаться между документами в порядке очередности их создания - от первого к последнему.
Альтернатива сочетаниям клавиш — следующий макрос:
Sub ChangeWindow() 
On Error GoTo ChangeWinErr 
Set bb = ActiveWindow.Next 
  If Windows.Count > 1 Then 
    bb.Activate 
    Exit Sub 
  End If 
ChangeWinErr: 
Windows(1).Activate 
End Sub
Прокомментировать: http://vbatips.ru/2007/11/05/bystroe-peremeshhenie-mezhdu-otkrytymi-dokumentami-word/

Подсчет символов в выделенном фрагменте текста

Для подсчета количества символов в строках используется функция Len. Чтобы подсчитать число символов в выделенном фрагменте текста можно воспользоваться следующим макросом:
Sub lenCharacters()
Dim selL As Long
selL = Len(Selection)'Возвращает длину выделенного фрагмента
'текста в виде числа
MsgBox selL
End Sub
Обратите внимание, что в подсчет символов помимо букв включаются также пробелы и знаки препинания.

Прокомментировать: http://vbatips.ru/2007/11/06/podschet-simvolov-v-vydelennom-fragmente-teksta/

Как определить нахождение курсора ввода в ячейке таблицы

Как узнать, находится ли курсор ввода в таблице в документе Word или нет? Для этого можно воспользоваться простым решением:
Sub PointIntoTable
Set rngTable = Selection.Range
If Not rngTable.Information(wdWithInTable) Then
    MsgBox prompt:="Курсор находится вне таблицы"
Else
 ... 'ваш код после условия
End if
End sub
Прокомментировать: http://vbatips.ru/2007/11/07/kak-opredelit-naxozhdenie-kursora-vvoda-v-yachejke-tablicy/

Как создать ярлык для программы с помощью макроса

Макрос для создания ярлыка редактора "Блокнота" на рабочем столе или в папке "Мои документы":
Sub MakeShortcutNotepad()
Dim WSH As Object
Dim WSHShortcut As Object
Dim strPath As String
Set WSH = CreateObject("WScript.Shell")
  ' strPath = WSH.SpecialFolders("MyDocuments") & "\" & "Notepad.lnk" 'Мои документы
  strPath = WSH.SpecialFolders("Desktop") & "\" &   "Notepad.lnk" 'рабочий стол
Set WSHShortcut = WSH.CreateShortcut(strPath)
With WSHShortcut
  .TargetPath = Environ("WINDIR") & "\" & "system32\notepad.exe"
  .Description = "make shortcut to notepad"
  .IconLocation = Environ("WINDIR") & "\" & "system32\notepad.exe,0"
  .RelativePath = "C:\temp"
  .WorkingDirectory = "C:\"
  .Hotkey = "Ctrl+Alt+Q"
  .Save
End With
End Sub
Прокомментировать: http://vbatips.ru/2007/11/07/kak-sozdat-yarlyk-dlya-programmy-s-pomoshhyu-makrosa/

Макрос массового уменьшения размеров всех рисунков

Есть документ Word с картинками (их много) и текстом. Необходимо "ужать" количество страниц. Уменьшить шрифт текста - понятно, но как уменьшить размер всех картинок одновременно, скажем, на 50%?
Сделать это можно с помощью следующего макроса:
Первый вариант:
Sub changeImages()
Dim iShape As InlineShape 
For Each iShape In ActiveDocument.InlineShapes 
  iShape.Height = iShape.Height * 0.5 
  iShape.Width = iShape.Width * 0.5 
Next iShape 
End sub
Второй вариант для объектов InlineShapes и Shapes:
Sub changeImages2()
Dim pic As Object
For Each pic In ActiveDocument.Content.InlineShapes 
  If pic.Type = wdInlineShapePicture Then 
    pic.Height = pic.Height / 2 
    pic.Width = pic.Width / 2 
  End If 
Next 
For Each pic In ActiveDocument.Content.ShapeRange 
  If pic.Type = msoPicture Then 
    pic.Height = pic.Height / 2 
      If pic.LockAspectRatio = msoFalse Then 
        pic.Width = pic.Width / 2 
      End If 
  End If 
Next
End sub
Обратите внимание, что если в документе нет объектов из коллекции Shapes (например, автофигур), то макрос вернет ошибку (второй вариант).

Прокомментировать: http://vbatips.ru/2007/11/10/makros-massovogo-umensheniya-razmerov-vsex-risunkov/


В избранное