Detecting sections with landscape orientation

[andreas]

Dear Experts:

Below macro lists sections with landscape orientation in a MsgBox. The
macro is running fine. There is two things I would like to have
different.

a) If just one (1) section features landscape orientation then the
"have" in the Message Box text should be replaced with "has".
b) If no (0) section breaks with landscape orientation are found, the
MsgBox text should say: "No sections with landscape orientation
found".

Help is much appreciated. Thank you very much in advance.

Regards, Andreas



Sub ReportLandscapeSections()

Dim strMessage As String
Dim i As Integer
Dim Sec As Section
strMessage = "Section "
For Each Sec In ActiveDocument.Sections
If Sec.PageSetup.Orientation = wdOrientLandscape Then
strMessage = strMessage & IIf(i > 0, ", ", "") & Sec.Index
i = i + 1
End If

Next Sec


MsgBox strMessage & " have landscape format."



End Sub

 

[Fumei2 via OfficeKB.com]

Option Explicit

Sub ReportLandscapeSections()
Dim counter As Long
Dim Sec As Section
Dim SecIndex As String

' get a counter number and Index string if applicable
For Each Sec In ActiveDocument.Sections
If Sec.PageSetup.Orientation = wdOrientLandscape Then
SecIndex = SecIndex & Sec.Index & ", "
counter = counter + 1
End If
Next Sec

Select Case counter
Case 0
MsgBox "No sections with landscape format Found."
Case 1
' trim the comma off of SecIndex
' note the added space before "has"
' and Section as singular
SecIndex = Left(SecIndex, 1)
MsgBox "Section " & SecIndex & " has a landscape format."
Case Else
' note NO space before "have"
' and Sections - plural
MsgBox "Sections " & SecIndex & "have landscape format."
End Select
End Sub

 

[Pesach Shelnitz]

Hi Andreas,

This may be what you're looking for.

Sub ReportLandscapeSections()

Dim strSecList As String
Dim strMsgStart As String
Dim strMsgEnd As String
Dim i As Integer
Dim Sec As Section

strSecList = ""
strMsgStart = "No sections "
strMsgEnd = "with landscape orientation were found."
i = 0
For Each Sec In ActiveDocument.Sections
If Sec.PageSetup.Orientation = wdOrientLandscape Then
strSecList = strSecList & IIf(i > 0, ", ", "") & Sec.Index
i = i + 1
If i = 1 Then
strMsgStart = "Section "
strMsgEnd = " has landscape orientation."
ElseIf i = 2 Then
strMsgStart = "Sections "
strMsgEnd = " have landscape orientation."
End If
End If
Next Sec
MsgBox strMsgStart & strSecList & strMsgEnd

End Sub

 

[andreas]

Option Explicit

Sub ReportLandscapeSections()
Dim counter As Long
Dim Sec As Section
Dim SecIndex As String

' get a counter number and Index string if applicable
For Each Sec In ActiveDocument.Sections
   If Sec.PageSetup.Orientation = wdOrientLandscape Then
      SecIndex = SecIndex & Sec.Index & ", "
      counter = counter + 1
    End If
Next Sec

Select Case counter
   Case 0
      MsgBox "No sections with landscape format Found."
   Case 1
      ' trim the comma off of SecIndex
      ' note the added space before "has"
      ' and Section as singular
      SecIndex = Left(SecIndex, 1)
      MsgBox "Section " & SecIndex & " has a landscape format."
   Case Else
      ' note NO space before "have"
      ' and Sections - plural
      MsgBox "Sections " & SecIndex & "have landscape format."
End Select
End Sub

Hi Fumei:

thank you very much for your professional help. It works as desired.
Regards, Andreas

 

[andreas]

Hi Andreas,

This may be what you're looking for.

Sub ReportLandscapeSections()

Dim strSecList As String
Dim strMsgStart As String
Dim strMsgEnd As String
Dim i As Integer
Dim Sec As Section

strSecList = ""
strMsgStart = "No sections "
strMsgEnd = "with landscape orientation were found."
i = 0
For Each Sec In ActiveDocument.Sections
    If Sec.PageSetup.Orientation = wdOrientLandscape Then
        strSecList = strSecList & IIf(i > 0, ", ", "") & Sec.Index
        i = i + 1
        If i = 1 Then
            strMsgStart = "Section "
            strMsgEnd = " has landscape orientation."
        ElseIf i = 2 Then
            strMsgStart = "Sections "
            strMsgEnd = " have landscape orientation."
        End If
     End If
Next Sec
MsgBox strMsgStart & strSecList & strMsgEnd

End Sub

--
Hope this helps,
Pesach Shelnitz
My Web site:http://makeofficework.com














- Zitierten Text anzeigen -

Hi Pesach,

as always, terrific help from you. It works just fine. Thank you very
much.

Regards, Andreas