Setting style for inserted text

[Uwe]

I'm still very new to this vba stuff....

So here is what I'm trying to do:
- read a file with file names of figures (png files),
- insert the files
- size them the figures
- add a caption string with style "Figures" after the figures

I've found most of the pieces, but now I'm running out of time. Maybe
someone could point me in the right direction.

The code below seems to handle the images fine and also inserts the
text, however, it does not set the style for the captions correctly,
i.e, the images also get the style "Figures". I want the custom style
"Figures" applied only to the text string and not the images.

Sub Macro4()
Dim FoundFile As Variant
Dim sFilename As Variant
Dim sname As String
Dim scaption As String
Dim s As InlineShape

' Function to get filename
sFilename = WordApplicationGetOpenFileName("*.txt", True, True)

With New Scripting.FileSystemObject
With .OpenTextFile(sFilename, ForReading)
Do Until .AtEndOfStream
sname = .ReadLine
scaption = sname
sname = sname + ".png"
Set s = Selection.InlineShapes.AddPicture
(FileName:=sname, LinkToFile:=False, _
SaveWithDocument:=True)

With s
.Height = 312.5
.Width = 442.1
End With

Selection.TypeText Chr(11)
Selection.Style = "Figures"
Selection.TypeText ("Figure ")
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="STYLEREF 2\s", PreserveFormatting:=True
Selection.TypeText (" - ")
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="SEQ Figure \*ARABIC \s 2",
PreserveFormatting:=True
Selection.TypeText (": " + scaption)
Loop

End With
End With
MsgBox "Done"
End Sub

 

[Graham Mayor]

You probably need something more like the following. I have added a few
notes.

Sub Macro4()
Dim FoundFile As Variant
Dim sFilename As String
Dim sname As String
Dim scaption As String
Dim s As InlineShape

' Function - not quoted - to get filename
sFilename = WordApplicationGetOpenFileName("*.txt", True, True)
'sFilename = "D:\My Documents\Test\Versions\filename.txt"
With New Scripting.FileSystemObject
With .OpenTextFile(sFilename, ForReading)
Do Until .AtEndOfStream
sname = .ReadLine
scaption = sname
sname = sname + ".png"
Set s =
Selection.InlineShapes.AddPicture(FileName:=sname, _
LinkToFile:=False, _
SaveWithDocument:=True)
With s
'what were the units of measurement?
.Height = InchesToPoints(3)
.Width = InchesToPoints(4.1)
End With
With Selection
'style for the pictures
.Style = "Normal"
.TypeParagraph
'Style = "Figures"
'Are you sure the default style for Captions is
Caption!
.Style = "Caption"
.TypeText ("Figure ")
'It is not clear what the styleref fields are doing
'.Fields.Add Range:=Selection.Range, _
'Type:=wdFieldStyleRef, Text:="2\s", _
'PreserveFormatting:=False
'.TypeText (" - ")
.Fields.Add Range:=Selection.Range, _
Type:=wdFieldSequence, _
Text:="Figure \*ARABIC \s 2", _
PreserveFormatting:=False
.TypeText (": " + scaption)
.TypeParagraph
End With
Loop
End With
End With
MsgBox "Done"
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Uwe]

Thank you very much for your help Graham. With your suggestions the
macro appears to do exactly what I want!

On your comments:
- Looks like that 'TypeParagraph was the key!
- yes, the function to get file name was not quoted, I found it
somewhere when I was looking for a dialog to get a filename in Word
2000 (which I'm forced to use for this project)
- Sizing: I will look at the units of measurements, etc. The numbers
came from a recorded macro during my experimentation
- the style used is indeed a custom style called "Figures"
- The Fields are also from a recorded macro, they add section number
and then number the figures in the section, i.e. in as section
(Heading 2) I get "Figure 2.9 - 1:....", "Figure 2.9 - 2:..."

I'll have to find a primer on vba somewhere to really understand what
I'm doing rather than piecing things I find/record together and hope
it works