Custom Set of Macros for document preparation

[runflacruiser]

Hi.
Sorry about that...Try it now.
-John

[gorgo2]

Originally Posted by runflacruiser

Hi.
Try this:

Option Explicit

Sub moveToPage()

Dim s As Shape, sr2 As New ShapeRange
Dim i As Integer, j As Integer
Dim x As Double, y As Double, w As Double, h As Double
Dim docY As Double, docX As Double
Dim moveIt As Boolean
Dim ref As cdrReferencePoint


docY = ActivePage.SizeHeight
docX = ActivePage.SizeWidth



For j = 1 To 9
    For i = 1 To ActivePage.Shapes.Count
        moveIt = False
        ActiveDocument.ReferencePoint = myRef(j)
        Set s = ActivePage.Shapes(i)
        s.GetPosition x, y
        If (s.PositionX < 0 Or s.PositionX > docX) Or (s.PositionY < 0 Or s.PositionY > docY) Then
            moveIt = True
        End If
        
        If moveIt = True Then 'move to layer or do something
            's.MoveToLayer "Desktop" 'move it to your layer
            sr2.Add s
            's.Fill.ApplyUniformFill CreateCMYKColor(100, 0, 0, 0) 'for testing
        End If
    Next i
Next j

If sr2.Count > 0 Then
    sr2.Delete
End If

End Sub

Private Function myRef(i As Integer) As cdrReferencePoint
    
    Select Case i
            Case 1
                myRef = cdrBottomLeft
            Case 2
                myRef = cdrBottomMiddle
            Case 3
                myRef = cdrBottomRight
            Case 4
                myRef = cdrCenter
            Case 5
                myRef = cdrMiddleLeft
            Case 6
                myRef = cdrMiddleRight
            Case 7
                myRef = cdrTopLeft
            Case 8
                myRef = cdrTopMiddle
            Case 9
                myRef = cdrTopRight
    End Select

End Function

-John

I think I like this version...however, on certain documents for some reason some of the objects on the page are also deleted. I have no clue why this happens and it seems intermittent...hmmm.

[runflacruiser]

Hi.
Did you try Shelby's version on the same page?

-John

[gorgo2]

Originally Posted by runflacruiser

Hi.
This one may do what you need. It's free and open source code. It already has a form and you can modify as needed.

-John

I have the form and I'd like to modify it. However how would I add code that will detect the currently open document and insert the file name as I save as?

[runflacruiser]

Hi.
You can put:

If ActiveDocument.FileName <> "" Then
    TextBox1.Value = ActiveDocument.FileName
End If

somewhere in the form code userform_initialize sub

-John

[gorgo2]

Originally Posted by runflacruiser

Hi.
Did you try Shelby's version on the same page?

-John

Okay, works better with Shelby's code. Will keep testing. Thanks all!

[gorgo]

Originally Posted by runflacruiser

Hi.
You can put:

If ActiveDocument.FileName <> "" Then
    TextBox1.Value = ActiveDocument.FileName
End If

somewhere in the form code userform_initialize sub

-John

SUCCESS!

[runflacruiser]

Cool!
I love to help.

Is that the one you got from my site. If so I posted the wrong one. Glad it works for ya though.

-John