Jakob_Ullmann
 
Beiträge: 1747
Erhaltene Danke: 15
Win 7, *Ubuntu GNU/Linux*
*Anjuta* (C, C++, Python), Geany (Vala), Lazarus (Pascal), Eclipse (Java)
|
Verfasst: Mi 19.08.09 14:36
Hi!
Ich wollte mir gerade das Einfügen einer nummerierten Formel in Word 2007 automatisieren lassen (per Makro). Also habe ich das mir mal schnell aufzeichnen lassen. Allerdings bleibt der Interpreter immer in der folgenden Zeile hängen, nämlich genau dann, wenn die eigentliche Formel eingefügt wird:
  Quelltext
1:
| WordBasic.EquationEdit 1 |
das gleiche passiert, wenn ich nur eine Formel einfüge und mir das als Makro speichere. Aber warum nur? Scheinbar funktioniert da bei der Aufzeichnung etwas nicht. Ich gebe mal den gesamten Code:
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:
| Sub Formelnummerieren()
'
' Formelnummerieren Makro
' Fügt eine nummerierte Formel ein.
'
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Tabellengitternetz" Then
.Style = "Tabellengitternetz"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=6, Extend:=wdExtend
Selection.Cells.Merge
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="(.)"
Selection.MoveLeft Unit:=wdCharacter, Count:=4
WordBasic.EquationEdit 1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF ""Überschrift 1"" \n ", PreserveFormatting:=True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SEQ Formel \*ARABIC \s 1"
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub |
Weiß zufällig jemand, wie man das trotzdem schafft?
EDIT: Problem gelöst. WordBasic ist also veraltet und galt nur für Word 6.0 und Word 95. Die entscheidende Klasse ist OMath. So funktioniert's (mit ein bisschen Copy und Paste aus der VBA-Hilfe):
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:
| Sub Formelnummerieren()
'
' Formelnummerieren Makro
' Fügt eine nummerierte Formel ein.
'
Dim objRange As Range
Dim objEq As OMath
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Tabellengitternetz" Then
.Style = "Tabellengitternetz"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=6, Extend:=wdExtend
Selection.Cells.Merge
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="(.)"
Selection.MoveLeft Unit:=wdCharacter, Count:=4
Set objRange = Selection.Range
objRange.Text = "E=mc^2"
Set objRange = Selection.OMaths.Add(objRange)
Set objEq = objRange.OMaths(1)
objEq.BuildUp
Selection.MoveRight Unit:=wdCharacter, Count:=9
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF ""Überschrift 1"" \n ", PreserveFormatting:=True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SEQ Formel \*ARABIC \s 1"
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCell, Count:=2
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
Selection.MoveRight Unit:=wdCell, Count:=1
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
Selection.MoveRight Unit:=wdCell, Count:=1
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End Sub |
Kann gerne verwendet werden, wenn es jemand braucht.
|
