How to change fonts in a word macro

B

Barlew

In this macro I want the first char to be in Bookman Old Style16pt Bold, then
the rest of each entry in Arial 10pt regular.


Public Sub MAIN()
Dim Td
Dim Yr
Dim Mn
Dim Mon$
Dim WD
Dim Count_
Dim L
Dim Dlg As Object
Dim Fname$
Dim Info$
Dim eoln
Dim L_$
Dim NC
ReDim ArrM__$(11)
ArrM__$(0) = "January": ArrM__$(1) = "February": ArrM__$(2) = "March"
ArrM__$(3) = "April": ArrM__$(4) = "May": ArrM__$(5) = "June"
ArrM__$(6) = "July": ArrM__$(7) = "August": ArrM__$(8) = "September"
ArrM__$(9) = "October": ArrM__$(10) = "November":
ArrM__$(11) = "December"
WordBasic.BeginDialog 320, 200, "Calendar Month to Do"
WordBasic.Text 10, 24, 100, 18, "Month :"
WordBasic.Text 10, 6, 100, 18, "Year :"
WordBasic.ListBox 70, 24, 120, 150, ArrM__$(), "Month"
WordBasic.TextBox 110, 6, 56, 18, "Year"
WordBasic.OKButton 210, 20, 84, 21
WordBasic.CancelButton 210, 49, 84, 21
WordBasic.EndDialog
Dim MonYear As Object: Set MonYear = WordBasic.CurValues.UserDialog
Td = WordBasic.Today()
Yr = WordBasic.Year(Td)
Mn = WordBasic.Month(Td) + 1 'default month is next month
If Mn >= 13 Then
Mn = 1
Yr = Yr + 1
End If

MonYear.Year = Str(Yr)
MonYear.Month = Mn - 1
If WordBasic.Dialog.UserDialog(MonYear) Then
Yr = WordBasic.Val(MonYear.Year)
Mn = MonYear.Month + 1
Mon$ = UCase(ArrM__$(MonYear.Month))
WD = WordBasic.Weekday(WordBasic.DateSerial(Yr, Mn, 1))
WordBasic.WW7_EditGoTo Destination:="Header"
WordBasic.Insert Mon$
WordBasic.WW7_EditGoTo Destination:="Table"
If WD > 1 Then 'goto the start date of the month
For Count_ = 1 To WD - 1
L = WordBasic.NextCell()
Next Count_
End If
Rem Defname$ = "D:\doc\hakol\diary" + Left$(mon$, 3) + ".doc"
Rem Defname$ = "D:\doc\diary.doc"
Rem Fname$ = InputBox$("Diary Information File", "Enter File Name",
Defname$)
Set Dlg = WordBasic.DialogRecord.FileOpen(False)
Dlg.Name = "d:\doc\diary.doc"
WordBasic.CurValues.FileOpen Dlg
WordBasic.Dialog.FileOpen Dlg
Fname$ = Dlg.Name
WordBasic.FileOpen Name:=Fname$, ConfirmConversions:=0, ReadOnly:=1
WordBasic.EditSelectAll
Info$ = WordBasic.[Selection$]() 'Info Has all the text
WordBasic.FileClose 2 'don't save
For Count_ = 1 To 31 'no more than 31 days will be processed
eoln = InStr(Info$, Chr(13))
If eoln > 0 Then
L_$ = WordBasic.[Left$](Info$, eoln)
If eoln < Len(Info$) Then
Info$ = Mid(Info$, eoln + 1)
Else
Info$ = " "
End If
Else
L_$ = Info$
Info$ = " "
End If
WordBasic.Insert L_$
WordBasic.ParaUp
WordBasic.WordRight 1, 1
WordBasic.FormatFont Font:="Bookman Old Style", Bold:=1,
Points:=16
WordBasic.CharRight 0
WordBasic.InsertPara
NC = WordBasic.NextCell()
If NC = 0 Then ' reached the End of the table, Goto start
WordBasic.StartOfColumn 0
WordBasic.StartOfRow 0
End If
If Len(Info$) < 2 Then GoTo Closedown 'no more days
Next Count_
Closedown:
Close 1
End If
End Sub
 
J

Jezebel

For god's sake, why the typographic obscenity?


Barlew said:
In this macro I want the first char to be in Bookman Old Style16pt Bold,
then
the rest of each entry in Arial 10pt regular.


Public Sub MAIN()
Dim Td
Dim Yr
Dim Mn
Dim Mon$
Dim WD
Dim Count_
Dim L
Dim Dlg As Object
Dim Fname$
Dim Info$
Dim eoln
Dim L_$
Dim NC
ReDim ArrM__$(11)
ArrM__$(0) = "January": ArrM__$(1) = "February": ArrM__$(2) = "March"
ArrM__$(3) = "April": ArrM__$(4) = "May": ArrM__$(5) = "June"
ArrM__$(6) = "July": ArrM__$(7) = "August": ArrM__$(8) = "September"
ArrM__$(9) = "October": ArrM__$(10) = "November":
ArrM__$(11) = "December"
WordBasic.BeginDialog 320, 200, "Calendar Month to Do"
WordBasic.Text 10, 24, 100, 18, "Month :"
WordBasic.Text 10, 6, 100, 18, "Year :"
WordBasic.ListBox 70, 24, 120, 150, ArrM__$(), "Month"
WordBasic.TextBox 110, 6, 56, 18, "Year"
WordBasic.OKButton 210, 20, 84, 21
WordBasic.CancelButton 210, 49, 84, 21
WordBasic.EndDialog
Dim MonYear As Object: Set MonYear = WordBasic.CurValues.UserDialog
Td = WordBasic.Today()
Yr = WordBasic.Year(Td)
Mn = WordBasic.Month(Td) + 1 'default month is next month
If Mn >= 13 Then
Mn = 1
Yr = Yr + 1
End If

MonYear.Year = Str(Yr)
MonYear.Month = Mn - 1
If WordBasic.Dialog.UserDialog(MonYear) Then
Yr = WordBasic.Val(MonYear.Year)
Mn = MonYear.Month + 1
Mon$ = UCase(ArrM__$(MonYear.Month))
WD = WordBasic.Weekday(WordBasic.DateSerial(Yr, Mn, 1))
WordBasic.WW7_EditGoTo Destination:="Header"
WordBasic.Insert Mon$
WordBasic.WW7_EditGoTo Destination:="Table"
If WD > 1 Then 'goto the start date of the month
For Count_ = 1 To WD - 1
L = WordBasic.NextCell()
Next Count_
End If
Rem Defname$ = "D:\doc\hakol\diary" + Left$(mon$, 3) + ".doc"
Rem Defname$ = "D:\doc\diary.doc"
Rem Fname$ = InputBox$("Diary Information File", "Enter File Name",
Defname$)
Set Dlg = WordBasic.DialogRecord.FileOpen(False)
Dlg.Name = "d:\doc\diary.doc"
WordBasic.CurValues.FileOpen Dlg
WordBasic.Dialog.FileOpen Dlg
Fname$ = Dlg.Name
WordBasic.FileOpen Name:=Fname$, ConfirmConversions:=0, ReadOnly:=1
WordBasic.EditSelectAll
Info$ = WordBasic.[Selection$]() 'Info Has all the text
WordBasic.FileClose 2 'don't save
For Count_ = 1 To 31 'no more than 31 days will be processed
eoln = InStr(Info$, Chr(13))
If eoln > 0 Then
L_$ = WordBasic.[Left$](Info$, eoln)
If eoln < Len(Info$) Then
Info$ = Mid(Info$, eoln + 1)
Else
Info$ = " "
End If
Else
L_$ = Info$
Info$ = " "
End If
WordBasic.Insert L_$
WordBasic.ParaUp
WordBasic.WordRight 1, 1
WordBasic.FormatFont Font:="Bookman Old Style", Bold:=1,
Points:=16
WordBasic.CharRight 0
WordBasic.InsertPara
NC = WordBasic.NextCell()
If NC = 0 Then ' reached the End of the table, Goto start
WordBasic.StartOfColumn 0
WordBasic.StartOfRow 0
End If
If Len(Info$) < 2 Then GoTo Closedown 'no more days
Next Count_
Closedown:
Close 1
End If
End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

what is the equivalent of this WordBasic code in VBA 2
How to modify a Word macro written for Windows so that will work on MAC 0
Automating Excel from Word - How to Sort a Range of Cells 6
Word: select text, search, delete, in a macro, how? 8
How to Call (utilize) a Sub() in a Class DLL? 9
How to export unlocked cells to a row in a text file. 0
how to disable security message in save attachments macro "A programis trying to access e-mail addre 5
How to loop a macro in a word document. 11

Top