Resizing all canvasses to the width of the printable area

[andreas]

Dear Experts:

I got a document where all the graphics have been inserted into
drawing canvasses. Almost all of the drawing canvasses reach into the
right margin.

How can I resize All drawing canvasses to the width of the printable
area of my document, i.e. the page width minus right margin minus left
margin.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

 

[Graham Mayor]

Without seeing the document - maybe

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
For i = 1 To ActiveDocument.Range.ShapeRange.Count
ActiveDocument.Range.ShapeRange(i).Select
If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
With Selection.Sections(1).PageSetup
iPageWidth = .PageWidth
iRtMargin = .RightMargin
iLmargin = .LeftMargin
End With
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = _
iPageWidth - iRtMargin - iLmargin
End If
Next i


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


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

 

[andreas]

Without seeing the document - maybe

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
For i = 1 To ActiveDocument.Range.ShapeRange.Count
    ActiveDocument.Range.ShapeRange(i).Select
    If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
        With Selection.Sections(1).PageSetup
            iPageWidth = .PageWidth
            iRtMargin = .RightMargin
            iLmargin = .LeftMargin
        End With
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Width = _
        iPageWidth - iRtMargin - iLmargin
    End If
Next i

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

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>







- Zitierten Text anzeigen -

Hi Graham,

working as desired. Thank you very much for your professional help.
Regards, Andreas

 

[andreas]

Without seeing the document - maybe

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
For i = 1 To ActiveDocument.Range.ShapeRange.Count
    ActiveDocument.Range.ShapeRange(i).Select
    If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
        With Selection.Sections(1).PageSetup
            iPageWidth = .PageWidth
            iRtMargin = .RightMargin
            iLmargin = .LeftMargin
        End With
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Width = _
        iPageWidth - iRtMargin - iLmargin
    End If
Next i

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

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>







- Zitierten Text anzeigen -

Hi Graham,

there is one thing I forgot to ask: I would like the macro to check at
the beginning how many drawing canvasses have been found and display
the results in a msgbox, such as ' 3 drawing canvasses have been
found' or
'0 drawing canvasses have been found". Is this possible? Help is much
appreciated. Thank you very much in advance. Regards, Andreas

 

[Graham Mayor]

To avoid running two loops to count the canvasses, you can display a message
box at the end

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
Dim iCount As Long
iCount = 0
For i = 1 To ActiveDocument.Range.ShapeRange.Count
If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
ActiveDocument.Range.ShapeRange(i).Select
iCount = iCount + 1
With Selection.Sections(1).PageSetup
iPageWidth = .PageWidth
iRtMargin = .RightMargin
iLmargin = .LeftMargin
End With
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = _
iPageWidth - iRtMargin - iLmargin
End If
Next i
MsgBox "There were " & iCount & " canvasses processed", _
vbInformation

If you want the count at the beginning you will need to run through the loop
twice - once to count, twice to process.

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
Dim iCount As Long
iCount = 0
For i = 1 To ActiveDocument.Range.ShapeRange.Count
If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
iCount = iCount + 1
End If
Next i
MsgBox "There are " & iCount & _
" canvasses to be processed", _
vbInformation
For i = 1 To ActiveDocument.Range.ShapeRange.Count
If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
ActiveDocument.Range.ShapeRange(i).Select
With Selection.Sections(1).PageSetup
iPageWidth = .PageWidth
iRtMargin = .RightMargin
iLmargin = .LeftMargin
End With
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = _
iPageWidth - iRtMargin - iLmargin
End If
Next i


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


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

 

[andreas]

To avoid running two loops to count the canvasses, you can display a message
box at the end

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
Dim iCount As Long
iCount = 0
For i = 1 To ActiveDocument.Range.ShapeRange.Count
    If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
    ActiveDocument.Range.ShapeRange(i).Select
        iCount = iCount + 1
        With Selection.Sections(1).PageSetup
            iPageWidth = .PageWidth
            iRtMargin = .RightMargin
            iLmargin = .LeftMargin
        End With
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Width = _
        iPageWidth - iRtMargin - iLmargin
    End If
Next i
MsgBox "There were " & iCount & " canvasses processed", _
vbInformation

If you want the count at the beginning you will need to run through the loop
twice - once to count, twice to process.

Dim iLmargin As String
Dim iRtMargin As String
Dim iPageWidth As String
Dim iCount As Long
iCount = 0
For i = 1 To ActiveDocument.Range.ShapeRange.Count
    If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
        iCount = iCount + 1
    End If
Next i
MsgBox "There are " & iCount & _
" canvasses to be processed", _
vbInformation
For i = 1 To ActiveDocument.Range.ShapeRange.Count
    If ActiveDocument.Range.ShapeRange(i).Type = msoCanvas Then
        ActiveDocument.Range.ShapeRange(i).Select
        With Selection.Sections(1).PageSetup
            iPageWidth = .PageWidth
            iRtMargin = .RightMargin
            iLmargin = .LeftMargin
        End With
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Width = _
        iPageWidth - iRtMargin - iLmargin
    End If
Next i

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

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>






- Zitierten Text anzeigen -

Dear Graham,

I really appreciate your terrific help. Great. It works as desired.
Thank you very much in advance. Regards, Andreas