English |
Deutsch / German |
This page contains some commonly useful macros for Microsoft Word. | Diese Seite enthält einige allgemein nützliche Makros für Microsoft Word. |
See Excel Macros for some common information about macros, copyright, etc. | Die Seite Excel Macros enthält einige allgemeine Informationen über Makros, Copyright, etc. |
Name of Macro | Description |
AutoOpen | This macro name is predefined by Word. It is automatically executed after
opening any file. The following lines cause Word to jump to the last
location in the file before it had been closed. The same does manually
pressing SHIFT+F5. (If Word does not know
this location, it may, unfortunately, switch to another open Word file.)Sub AutoOpen() Application.GoBack End Sub |
vertausche_zeilen_mit_spalten | ENGLISH: If you want to transpose the lines of a Word table into columns (and vice
versa), you might expect Word to offer such a function. But this is not
true. So this macro may help you to do this. Just locate the cursor at
any location within the table and call this macro. DEUTSCH: Wenn Sie die Zeilen einer Word-Tabelle in Spalten umwandeln
möchten (oder umgekehrt), würden Sie vielleicht erwarten, daß Word Ihnen
diese Funktion bietet. Leider ist dies nicht der Fall. Dieses Makro führt
diese Aufgabe für Sie aus, wenn Sie die Eingabemarke (Cursor) an eine
beliebige Stelle in der Tabelle positionieren und dann dieses Makro
aufrufen. |
Sub vertausche_zeilen_mit_spalten() ' ' vertausche_zeilen_mit_spalten Makro ' Nimmt die Tabelle, in der momentan der Cursor steht (nicht mehrere Tabellen ' gleichzeitig markieren!) und vertauscht den Inhalt der Zeilen mit dem der Spalten ' ' Dim rows As Integer Dim cols As Integer Dim r As Integer Dim c As Integer Dim t As Table Dim val_1 As String Dim val_2 As String Dim ll As Integer ' nur zum Testen Dim i As Integer ' nur zum Testen Dim ass As Integer ' nur zum Testen 'Im Internet fand ich: '"In der Regel ist die Tabelle, in der der Cursor steht, '... .Tables(1). Aber da Word bekanntlich eine Zicke ist, 'würde ich aus der aktiven Tabelle einen Range bilden." '(Bem. BA: Dies ist unbedingt nötig, sonst klappt es nicht!) Dim tRange As Range Set tRange = Selection.Tables(1).Range Set t = tRange.Tables(1) ' This is the table in the selection rows = t.rows.Count ' stores the initial value. Do not change! cols = t.Columns.Count ' stores the initial value. Do not change! ' Wenn man das Screen-Updating während der Operationen an der Tabelle ' abschaltet, geht es viel schneller, weil sonst bei jedem Schritt die ' Tabellenmaße neu berechnet werden! Wenn man lieber zuschaut, wie das ' alles gemacht wird, kann man die naechste Zeile einfach auskommentieren. Application.ScreenUpdating = False ' SO DACHTE ich, die Wirklichkeit scheint aber anders zu sein (als ich von ' Excel her gewohnt bin): Die Tabelle wird anscheined trotzdem neu berechnet. ' Man sieht zwar die Tabelle nicht sich verändern, aber der Pagescroller ' zittert, was zeigt, daß sich die Tabellenhöhe immer wieder verändert. ' Deshalb fixiere ich hier noch die Tabellenformate. t.AutoFitBehavior (wdAutoFitFixed) ' Aber auch das hilft nicht allzuviel. ' STEP 1) Zuerst muessen wir die Tabelle quadratisch machen While t.rows.Count < t.Columns.Count t.rows.Add ' Without parameter: add row at the end Wend While t.rows.Count > t.Columns.Count t.Columns.Add Wend ' STEP 2) Schleife über die Zeilen, wobei nur die Haelfte links von der Diagonalen ' durchlaufen wird, weil die andere Haelfte beim Vertauschen zweier ' Zellinhalte automatisch mitbehandelt wird. For r = 2 To t.rows.Count For c = 1 To r - 1 ' Leider ist es mir nicht gelungen, den Zellinhalt direkt zu aendern, ' Der Umweg ueber die Selection ist zeitaufwendig! t.Cell(r, c).Select val_1 = Selection.text t.Cell(c, r).Select val_2 = Selection.text ll = Len(val_2) For i = 1 To ll ass = Asc(Mid(val_2, i, 1)) Next i t.Cell(r, c).Select Selection.text = remove_unneeded_chars(val_2) ' see comment in function t.Cell(c, r).Select Selection.text = remove_unneeded_chars(val_1) Next c Next r ' STEP 3) Zum Schluss werden noch die überzähligen Zeilen oder Spalten entfernt, ' die ja leer sind, wenn alles funktioniert hat. Beachte: Wenn Zeilen ' hinzugefuegt wurden, muessen jetzt Spalten entfernt werden! While t.rows.Count > cols t.rows.Item(t.rows.Count).Delete Wend While t.Columns.Count > rows t.Columns.Item(t.Columns.Count).Delete Wend ' Je nach Wunsch kann man hier die Tabellenformate automatisch berechnen ' lassen oder nicht, indem man diese Zeile auskommentiert. t.AutoFitBehavior (wdAutoFitContent) ' Nun zeigen wir wieder das richtige Bild Application.ScreenUpdating = True End Sub Function remove_unneeded_chars(ByVal text As String) As String ' Beim Vertauschen der Zellinhalte wurde jedesmal ein CHR(13) angefügt (vor dem ' Zellen-Ende-Marker CHR(7). Warum habe ich nicht herausgefunden. Abhilfe ' schafft diese Funktion, indem sie diese Zeichen entfernt, wenn dahinter nichts ' anderes mehr folgt. (So werden natürlich auch beabsichtigte CHR(13) entfernt. ' Wer das nicht will, kann ganz leicht diese Funktion so abändern, daß nur ' der eingegebene String zurückgegeben wird.) Dim pos As Integer pos = 0 If Asc(Mid(text, Len(text), 1) = 7) Then ' This is the end marker of a table element For pos = Len(text) - 1 To 1 Step -1 If Asc(Mid(text, pos, 1)) <> 13 Then Exit For End If Next pos ' Mid(text, pos + 1, Len(text) - pos - 1) = "" remove_unneeded_chars = Left(text, pos) & Chr(7) End If End Function
Responsible: Bernhard Abmayr of EDV Abmayr. Last change: June, 12th, 2012