macro to make picture in-line with text

[xppuser]

hi all,

wxp pro sp2, office 2003 pro sp2,

i have a large document with lot of figures (300+). it just transpires to me
that as a result of collaborative work, we end-up with a mix-bag of figures
that are in-line with text, square or tight in layout.

i wonder whether someone would be kind enough to provide me with a macro
that would enable figures to be changed to in-line with text, if this is
macro-able. or is the solution one of swallow the bitter pill and
check/convert figure 1 by 1?

thanks for your advice/help,
jes

 

[Jay Freedman]

This simple macro will convert all floating (square, tight, etc.) pictures
to in-line ones:

Sub InlinePictures()
Dim oShp As Shape
For Each oShp In ActiveDocument.Shapes
oShp.ConvertToInlineShape
Next
End Sub

They will then appear at the start of the paragraph to which they were
anchored, which probably isn't where you want them. If you can describe what
further positioning you want, it may be possible to add that to the macro.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[Cindy M.]

Hi =?Utf-8?B?eHBwdXNlcg==?=,

wxp pro sp2, office 2003 pro sp2,

i have a large document with lot of figures (300+). it just transpires to me
that as a result of collaborative work, we end-up with a mix-bag of figures
that are in-line with text, square or tight in layout.

i wonder whether someone would be kind enough to provide me with a macro
that would enable figures to be changed to in-line with text, if this is
macro-able. or is the solution one of swallow the bitter pill and
check/convert figure 1 by 1?

Here's a code snippet that will make each wrapped graphic inline, where
possible. Note that not all graphical objects can be formatted inline with
text. Things made with the Drawing tools, for example. The following skips
these types so that you can make a decision about what you want to do with them

Sub GraphicsInline()
Dim shp As Word.Shape

On Error Resume Next
'Not all shapes can be put inline
'Leave these for manual decision
For Each shp In ActiveDocument.Shapes
shp.ConvertToInlineShape
Next
End Sub


Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail

 

[PegDalyPA]

HELP!

Hi. This last sample may work for my problem, too, but I can't get it to
work. I'm just learning VBA (on my own from the help files) so please excuse
any idiocy in the question.

I'm working in Word 2003 with VBA and I'm trying to delete all shapes in all
headers of my current document IF their assigned name (assigned by another
macro) is LIKE "PowerPlusWaterMarkDraft*". There could be a number at the
end of the name or it could be a letter and a number, hence the asterisk, e.g.
, PowerPlusWaterMarkDraft1, PowerPlusWaterMarkDraft1a,
PowerPlusWaterMarkDraft2, etc.

I tried the following code based on the sample, but it didn't work. Any idea
what I'm doing wrong?

Sub MY_DELETE_DRAFT()

' ** DESCRIPTION **
' Disable Draft background in ALL headers

Dim shp As Word.Shape

On Error Resume Next

'Go into Header (I think it can't find shapes in headers unless cursor is
in a header)
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

For Each shp In ActiveDocument.HeaderFooter.ShapeRange
If Selection.ShapeRange.name Like "PowerPlusWaterMarkDraft*" Then
Selection.ShapeRange.Delete
End If
Next

End Sub

Thanks for any help you can provide. I'm losing my mind over this!

Peg

 

[Jean-Guy Marcil]

PegDalyPA was telling us:
PegDalyPA nous racontait que :

HELP!

Hi. This last sample may work for my problem, too, but I can't get
it to work. I'm just learning VBA (on my own from the help files) so
please excuse any idiocy in the question.

I'm working in Word 2003 with VBA and I'm trying to delete all shapes
in all headers of my current document IF their assigned name
(assigned by another macro) is LIKE "PowerPlusWaterMarkDraft*".
There could be a number at the end of the name or it could be a
letter and a number, hence the asterisk, e.g. ,
PowerPlusWaterMarkDraft1, PowerPlusWaterMarkDraft1a,
PowerPlusWaterMarkDraft2, etc.

I tried the following code based on the sample, but it didn't work.
Any idea what I'm doing wrong?

Sub MY_DELETE_DRAFT()

' ** DESCRIPTION **
' Disable Draft background in ALL headers

Dim shp As Word.Shape

On Error Resume Next

'Go into Header (I think it can't find shapes in headers unless
cursor is in a header)

Avoid the Selection Object like the pest, especially when dealing with
headers/footers. It is very unreliable and slows down the execution.
In other words, there is no need to have code actually place the cursor in a
header or footer.

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

For Each shp In ActiveDocument.HeaderFooter.ShapeRange
If Selection.ShapeRange.name Like
"PowerPlusWaterMarkDraft*" Then
Selection.ShapeRange.Delete End If
Next

End Sub

Thanks for any help you can provide. I'm losing my mind over this!

It is always better to start a new thread than to latch on an existing one
with a different question, even if it is sort of related.

Meanwhile, for more detailed information on dealing with storyranges and
searching them in documents, see:
http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm

I have adapted that code for your purpose:

'_______________________________________
Option Explicit
'_______________________________________
Public Sub FindReplaceHeaderFooter()

Dim rngStory As Word.Range
Dim pFindTxt As String
Dim lngJunk As Long

pFindTxt = "PowerPlusWaterMarkDraft"

'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
Select Case rngStory.StoryType
'All headers, footers...
Case 6, 7, 8, 9, 10, 11
SearchInStory rngStory, pFindTxt
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next

End Sub
'_______________________________________

'_______________________________________
Public Sub SearchInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String)

Dim shpToDelete As Shape

If rngStory.ShapeRange.Count > 0 Then
For Each shpToDelete In rngStory.ShapeRange
If InStr(1, shpToDelete.Name, strSearch) > 0 Then
shpToDelete.Delete
End If
Next
End If

End Sub
'_______________________________________

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[PegDalyPA via OfficeKB.com]

Jean-Guy, you are my ANGEL!

It works beautifully! I don't even know what all of the code is doing (I can
understand most of it, but was never trained for this), but I've tried
running it on several sample documents and it worked on every one! Merci!
Merci! Merci! Now I just need to finish writing the code that actually
inserts those shapes into ALL sections, instead of just the first two headers
in a document, which is as far as I had gotten with that other code.

Thanks again for your help,
Peg