Syntax | Po polsku | English | Zamiast CV | Polecam | Licznik znaków | Makra


Garść makr różnych

Czy przydały Ci się niektóre makra opublikowane na tej stronie? Potrzebujesz innego makra, którego tu nie ma? Możesz mnie zmotywować do dalszej aktywności, przekazując drobną, dowolnie określoną przez siebie kwotę. Możesz do tego użyć systemu Paypal.

A może chcesz zamówić konkretne makro? Mam doświadczenie w tworzeniu róznych makr związanych z obróbką plików w formacie XML, przygotowywaniem ich do tłumaczenia za pomocą Tradosa w edytorze Word i przetwarzaniem po tłumaczeniu. Opisz swój problem tutaj - możliwe, że potrafię znaleźć rozwiązanie.
Uwaga: Moja znajomość rzeczy nie obejmuje Worda 2007 i nowszych, ponieważ nie mam i prawdopodobnie nie będę miał tej wersji pakietu MS Office.


Polecam również:

Zestaw darmowych makr do edytora OpenOffice Writer: ooomakro


Uwaga: niektóre makra były testowane w programie Word 97, inne w Word 2002 (XP). Aby sprawdzić działanie makra w wybranej wersji edytora, wystarczy je w nim uruchomić. Bardzo proszę o zgłaszanie błędów tutaj


1. Kapitaliki


Sub Kapitaliki()
'
' SmallCaps Makro
' Makro zapisane 99-05-25 przez Piotr Bieńkowski
'
    Selection.Font.SmallCaps = True
    Selection.EndKey Unit:=wdLine
    Selection.Font.SmallCaps = False
End Sub

Opis Zaznaczonemu fragmentowi tekstu nadaje atrybut Kapitaliki.

Uruchamianie Skrót klawiszowy lub przycisk na pasku.
  

 

[ Na górę ]

2. Pogrubienie akapitu



Sub BoldPara()
' Makro zapisane 99-05-25 przez Piotr Bieńkowski
    Selection.Paragraphs(1).Range.Select
    Selection.Font.Bold = True
    Selection.EndKey Unit:=wdLine
    Selection.Font.Bold = False
End Sub



Opis zaznacza akapit i nadaje mu atrybut Pogrubiebie.

Uruchamianie Ja wolę skrót klawiszowy, ale może być również przycisk.
 

[ Na górę ]

3. Pogrubienie i podkreślenie akapitu



Sub BoldUndPara()
' Makro zapisane 99-05-25 przez Piotr Bieńkowski
    Selection.Paragraphs(1).Range.Select
    Selection.Font.Bold = True
    Selection.Font.Underline = True
    Selection.EndKey Unit:=wdLine
    Selection.Font.Bold = False
    Selection.Font.Underline = False
End Sub

Opis zaznacza akapit i nadaje mu atrybut Pogrubiebie i Podkreślenie.

Uruchamianie Ja wolę skrót klawiszowy, ale może być również przycisk.

 

[ Na górę ]

4. Wyzerowanie atrybutów tekstu



Sub BIUFalse()
'
'
' Makro zapisane 99-09-06 przez Piotr Bieńkowski
'
    Selection.Font.Bold = False
    Selection.Font.Underline = False
    Selection.Font.Italic = False
    Selection.Font.SmallCaps = False
End Sub

Opis Bywa że jakiemuś kawałkowi tekstu nadajemy różne formatowania, a potem nie
możemy się ich pozbyć. Ustaw kursor za zmodyfikowanym fragmentem i uruchom makro. To
makro 'ucina' Pogrubienie, Podkreślenie, Kursywę i Kapitaliki. Łatwo można je
zmodyfikować, aby ucinało więcej atrybutów.

Uruchamianie Ja wolę skrót klawiszowy, ale może być i przycisk na pasku.

 

[ Na górę ]

5. Ułamki i cale


Sub InchFrac()
'
' InchFrac Makro
' Makro zapisane 99-09-14 przez Piotr Bienkowski
'
    Selection.MoveLeft Unit:=wdCharacter, Count:=3
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Superscript = wdToggle
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Subscript = wdToggle
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Font.Subscript = wdToggle
    Selection.TypeText Text:=""""
End Sub

Opis Chcesz, żeby ułamki wyglądały na ułamki? Word tylko niektóre zamienia na
typograficzne. Jak zrobić aby 5/8 miało '5' u góry a '8' u dołu? Użyj tego makra. Napisz np 5/8 i uruchom makro. Makro to dopisuje również znak " na oznaczenie cali, bo stosuję je do ułamków cali. Jeżeli tego nie chcesz, usuń ostatnią linię przed 'End Sub'.

Uruchamianie Ja wolę skrót klawiszowy, ale może być i przycisk na pasku.
 

[ Na górę ]

6. Prosty cudzysłów



Sub StraitQuot()
'
' StraitQuot Makro
' Makro zapisane 99-09-14 przez Piotr Bienkowski
'
    Selection.InsertSymbol CharacterNumber:=34, Unicode:=True
End Sub

Opis Czasami zachodzi potrzeba wstawienia prostego cudzysłowu, a nie typograficznego. Z nieznanych mi przyczyn, Word podmienia prosty cudzysłów na typograficzny, jeśli wstawia się go przez 'Wstaw - Symbol'. Nie robi tego, jeśli się użyje tego makra.

Uruchamianie Proponuję przycisk na pasku.
  

 

[ Na górę ]

7. Następne Okno --- Poprzednie Okno


Sub NastOkno()
    Application.Run MacroName:="NextWindow"
End Sub


Sub PoprzOkno()
    Application.Run MacroName:="PrevWindow"
End Sub

 
Opis Nie wiem czy się zgodzisz, ale jeśli pracujesz z wieloma dokumentami Worda
jednocześnie (tzn. masz wiele otwartych dokumentów) to przełączanie się między nimi
przez Menu 'Okno' nie należy do najefektywniejszych czynności. Dwa powyższe makra służą do przełączania się do następnego lub poprzedniego okna.

Jak się okazało, istnieje skrót klawiszowy Ctrl-F6, który robi dokładnie to samo
Ale może komuś bardziej podoba się przełączanie przez klikanie.

Uruchamianie Najlepiej przypisać do paska przycisków a przyciskom nadać ikonki ze
strzałkami w lewo i w prawo. (Word ma takie gotowe).

[ Na górę ]

8. Zaznaczanie akapitu



Sub SelPara()
'
' SelPara Makro
' Makro zapisane 99-04-21 przez Piotr Bieńkowski
' original idea by Paweł Lutze
With Selection
    .StartOf Unit:=wdParagraph, Extend:=wdMove
    .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
End With
End Sub

Opis: Jezeli zamiast klikać dwukrotnie w akapit wolisz skrót klawiszowy, to makro jest dla ciebie.
Makro to można również wykorzystać w innych makrach, które mogą odwoływać się do niego gdy zachodzi potrzeba zaznaczenia aktualnego akapitu.

Uruchamianie Możesz je podpiąć pod skrót klawiszowy lub przycisk na pasku przycisków (wtedy zyskujesz jedno kliknięcie zamiast dwóch).

  

 

[ Na górę ]

9. Tabelka bez ramek



Sub TableBorderNone()
'
' TableBorderNone Makro
' Makro zapisane 99-05-13 przez Piotr Bieńkowski
'
    With Selection.Tables(1)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColorIndex = wdAuto
    End With
End Sub

Opis Za jednym kliknięciem pozbaw tabelę wszystkich widocznych linii.

Uruchamianie Proponuję umieścić przycisk na pasku Tabele i narzędzia.

 

[ Na górę ]

10. Pionowy podział komórki na dwie



Sub SplitCellin2()
'
' SplitCellin2 Makro
' Makro zapisane 99-08-10 przez Piotr Bieńkowski
'
    Selection.Cells.Split NumRows:=1, NumColumns:=2, MergeBeforeSplit:=False
End Sub

Opis Bieżącą komórkę tabeli dzieli pionowo na dwie.

Uruchamianie Proponuję przycisk na pasku "Tabele i krawędzie".
 

[ Na górę ]

11. Podział komórki poziomo na dwie



Sub SplitCellHorizontally()
'
' SplitCellHorizontally Makro
' Makro zapisane 99-08-13 przez Piotr Bieńkowski
'
    Selection.Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False
End Sub

Opis Bieżącą komórkę tabeli dzieli poziomo na dwie.

Uruchamianie Proponuję przycisk na pasku "Tabele i krawędzie".

 

[ Na górę ]

12. Numerowanie komórek tabeli z użyciem pola Seq


Sub Sequitur()
'
' Sequitur Makro
' Makro zapisane 99-09-06 przez Piotr Bieńkowski
'
    Selection.PreviousField.Select
    Selection.Copy
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.Paste
    Selection.PreviousField.Select
    Selection.Fields.Update
    Selection.MoveRight Unit:=wdCell
End Sub

Opis Numerowanie pionowo kolejnych komórek tabeli na przykład w kolumnie "L.p.". Należy ręcznie wstawić pierwsze pole typu 'Seq' w komórce rozpoczynającej numerację. Aby wstawić kolejny numer, należy ustawić kursor w następnej komórce poniżej i uruchomić makro. Makro kopiuje pole, uaktualnia je, a następnie przesuwa kursor o jedną komórkę w prawo, gdzie możemy umieścić treść danego punktu itd.

Uruchamianie: Proponuję przycisk na pasku "Tabele i krawędzie".
 

 

[ Na górę ]

13. Numerowanie komórek tabeli zwykłym tekstem



Sub NumerowanieKolumn()
' Makro zapisane 24-11-1999 przez Piotr Bienkowski
numer = 1
While Selection.Information(wdWithInTable) = True
        Selection.InsertAfter numer
        numer = numer + 1
        Selection.MoveDown Unit:=wdLine, Count:=1
Wend
End Sub

Opis: Makro numeruje wiersze tabeli od komórki, w której stoi kursor
do ostatniej komórki w danej kolumnie. Najlepiej uruchamiać na "świeżo utworzonej" tabeli.

Uruchamianie: Przycisk na pasku lub skrót klawiszowy.

[ Na górę ]

14. Wypełnianie kolumny zadanym ciągiem znaków



Sub Kolwyp()
' PODANIE CIĄGU ZNAKÓW
Dim Komunikat, Tytul, Domyslne, Ciag
Komunikat = "Podaj ciag znakow"
    ' Ustaw tekst monitu.
Tytul = "Ciag znakow" ' Ustaw tytul.
Domyslne = "szt" ' Ustaw wartosc domyslna.
' Wyswietl komunikat, tytul i wartosc domyslna.
Ciag = InputBox(Komunikat, Tytul, Domyslne)
'WYPEŁNIENIE
While Selection.Information(wdWithInTable) = True
        Selection.TypeText Text:=Ciag
        Selection.MoveDown Unit:=wdLine, Count:=1
Wend
End Sub

15. Zamykanie wszystkich otwartych dokumentów bez zapisywania


Sub CloseAllNoSave()
Application.Documents.Close SaveChanges:=wdDoNotSaveChanges
End Sub

Działanie makra sprawdzone tylko w programie Word 2002 (XP).

16. Prostowanie tekstu otrzymanego z programu OCR


Sub BeautifyOCR()
' BeautifyOCR Makro
' Makro zapisane 2003-08-14 przez Piotr Bieńkowski
' Poprawione 2005-10-05
For x = 1 To ActiveDocument.Paragraphs.Count
    ActiveDocument.Paragraphs(x).Range.Select
    Selection.Bookmarks.Add Name:="FixingPara", Range:=Selection.Range
    Selection.Collapse Direction:=wdCollapseStart
    myFontSize = Selection.Font.Size
    Selection.GoTo What:=wdGoToBookmark, Name:="FixingPara"
    With Selection.Font
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Size = myFontSize
    End With
    Selection.Bookmarks("FixingPara").Delete
Next x
End Sub

Jeżeli chcemy zachować układ tekstu skanowanego np. w programie FineReader, będzie on powykręcany na wszelkie możliwe sposoby, co będzie powodować jego dziwny i czasami nieestetyczny wygląd na ekranie i na wydruku. Co gorsza jest to zmora dla programów wspomagających tłumaczenie, ponieważ każda zmiana formatu może być w takich programach oznaczona jako nowy tag lub kolor (np. w SDLX). Zdarzają się akapity, w których jest kilkadziesiąt (!) zmian formatów.

To makro zeruje atrybuty powodujące zniekształcanie tekstu, tylko minimalnie naruszając jego układ na stronie (Zmiana skalowania czcionki może sprawić, że się „rozjedzie”). Makro sprawdza wielkość czcionki dla pierwszego znaku w akapicie i ustawia taki rozmiar dla bieżącego akapitu. Uwaga: tego makra na razie nie ma w szablonie.

17. Zmiana języka w całym dokumencie

W pierwszej chwili można pomyśleć: po co makro, jeśli można zrobić CTRL+A i zmienić język poleceniem Narzędzia > Język, ale to zmieni ustawienie języka tylko w głównym dokumencie, a pominie wszystkie tzw. stories, czyli np. nagłówki, stopki, czy pola tekstowe. Poniżej kod kilku makr, trzecie z nich przełącza ustawienie języka we wszystkich otwartych dokumentach. Ostatnie polecenie w każdym makrze wyłącza pasek recenzji, który nie wiadomo dlaczego często wyświetla mi się nieproszony. Zasługa za pomysł na te makra należy się Pawłowi Lutze, mój jest kod zmieniający język w polach tekstowych.


Sub langconvPL()
Dim mystoryrange As Range
For Each mystoryrange In ActiveDocument.StoryRanges
'mystoryrange.LanguageID = wdEnglishUS
mystoryrange.LanguageID = wdPolish
mystoryrange.NoProofing = False
Next mystoryrange
scount = ActiveDocument.Shapes.Count
For x = 1 To scount
ActiveDocument.Shapes(x).Select
If ActiveDocument.Shapes(x).TextFrame.HasText = True Then
ActiveDocument.Shapes(x).TextFrame.TextRange.Select
Selection.LanguageID = wdPolish
End If
Next x
Selection.Collapse Direction:=wdCollapseEnd
CommandBars("Reviewing").Visible = False
End Sub

Sub langconvEN()
Dim mystoryrange As Range
For Each mystoryrange In ActiveDocument.StoryRanges
mystoryrange.LanguageID = wdEnglishUS
mystoryrange.NoProofing = False
'mystoryrange.LanguageID = wdPolish
Next mystoryrange
scount = ActiveDocument.Shapes.Count
For x = 1 To scount
ActiveDocument.Shapes(x).Select
If ActiveDocument.Shapes(x).TextFrame.HasText = True Then
ActiveDocument.Shapes(x).TextFrame.TextRange.Select
Selection.LanguageID = wdEnglishUS
End If
Next x
Selection.Collapse Direction:=wdCollapseEnd
CommandBars("Reviewing").Visible = False

End Sub

Sub LangConvEN_Batch()
Dim mystoryrange As Range
For z = 1 To Application.Documents.Count
    Application.Documents(z).Activate
    For Each mystoryrange In ActiveDocument.StoryRanges
    mystoryrange.LanguageID = wdEnglishUS
    mystoryrange.NoProofing = False
'mystoryrange.LanguageID = wdPolish
    Next mystoryrange
    scount = ActiveDocument.Shapes.Count
    For x = 1 To scount
        ActiveDocument.Shapes(x).Select
        If ActiveDocument.Shapes(x).TextFrame.HasText = True Then
        ActiveDocument.Shapes(x).TextFrame.TextRange.Select
        Selection.LanguageID = wdEnglishUS
        End If
    Next x
Selection.Collapse Direction:=wdCollapseEnd
Next z
CommandBars("Reviewing").Visible = False
End Sub

18. Zamiana miejscami dwóch słów.


Sub Reverse()
Dim Dwaslowa As New Collection
slowo1 = Selection.Words(1)
last1 = Right(slowo1, 1)
slowo2 = Selection.Words(2)
last2 = Right(slowo2, 1)
If last1 = " " Then
slowo1 = RTrim(slowo1)
End If
If last2 = " " Then
slowo2 = RTrim(slowo2)
End If
Dwaslowa.Add slowo1
Dwaslowa.Add slowo2
Selection.Delete
Selection.InsertAfter Dwaslowa.Item(2)
Selection.InsertAfter " "
Selection.InsertAfter Dwaslowa.Item(1)
Selection.InsertAfter " "
Selection.Collapse Direction:=wdCollapseStart
End Sub

Zdania szyk poprawisz w mig! :) Wystarczy zaznaczyć dwa słowa i nacisnąć skrót klawiszowy (lub kliknąć ikonkę), do którego przypisano makro.

19. Zaznaczanie tekstu między nawiasami okrągłymi.


Sub SelectBetweenRoundBrackets()
    Selection.MoveEndUntil Cset:="(", Count:=wdBackward
    Selection.MoveEndUntil Cset:=")", Count:=wdForward
End Sub

Łatwo można je dostosować do zaznaczania tekstu między innymi parami znaków.

20. Poprawianie polskich znaków w tekście z pliku PDF.

Tekst po polsku skopiowany z pliku PDF lub wydobyty za pomocą programu FineReader po wprowadzeniu do Worda może mieć dziwne znaczki zamiast polskich liter. To makro poprawia większość takich znaczków, a po jego przebiegu konieczne jest jeszcze sprawdzenie poprawności pisowni, bo niektóre zamiany mogą być nieprawidłowe. Ponieważ makro jest dość długie, jego kod znajduje się w pliku *.bas i w szablonie.


Życzę zadowolenia z używania zamieszczonych tutaj makr.

Masz pomysł na jakieś makro? Chciał(a)byś coś uprościć w swej codziennej pracy z programem M$ Word? Napisz - może będę mógł pomóc.

♦ Napisz wiadomość ♦

 

[ Na górę ]

Jak instalować: Plik makra.bas ze wszystkimi makrami można pobrać tutaj. Dalsze wskazówki dotyczące instalacji znajdziesz na stronie makro.html. Szablon z wszystkimi makrami można pobrać stąd, a sposób jego instalacji jest opisany tu

Ostatnio aktualizowano 25 marca 2009