マップ スケールの設定

'スケール変更
Private Sub ChangeScales_SelectionChange(ByVal newIndex As Long)
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument

    Dim pActiveView As IActiveView
    Set pActiveView = pMxDocument.ActiveView

    If TypeOf pActiveView Is IMap Then
        Dim pMap As IMap
        Set pMap = pActiveView
        pMap.MapScale = Right(ChangeScales.Item(newIndex), 6)

    ElseIf TypeOf pActiveView Is IPageLayout Then
        Dim pPageLayout As IPageLayout
        Set pPageLayout = pMxDocument.PageLayout

        Dim pGraphContainer As IGraphicsContainer
        Set pGraphContainer = pPageLayout

        pGraphContainer.Reset

        Dim pElement As IElement
        Set pElement = pGraphContainer.Next
        While Not pElement Is Nothing
            If TypeOf pElement Is IMapFrame Then
                Dim pMapFrame As IMapFrame
                Set pMapFrame = pElement

                pMapFrame.ExtentType = esriAutoExtentScale
                pMapFrame.MapScale = Right(ChangeScales.Item(newIndex), 6)

                pActiveView.Refresh
                pMapFrame.ExtentType = esriAutoExtentNone  // 再描画後に定数を変更

            End If
            Set pElement = pGraphContainer.Next
        Wend
    End If

End Sub

'MXDファイルを開く
Private Function MxDocument_NewDocument() As Boolean

    ChangeScales.RemoveAll

    ChangeScales.AddItem "1/   500"
    ChangeScales.AddItem "1/  1000"
    ChangeScales.AddItem "1/  2500"
    ChangeScales.AddItem "1/  5000"
    ChangeScales.AddItem "1/ 10000"
    ChangeScales.AddItem "1/ 12500"
    ChangeScales.AddItem "1/ 25000"
    ChangeScales.AddItem "1/ 50000"
    ChangeScales.AddItem "1/100000"
    ChangeScales.AddItem "1/200000"
End Function

Private Function MxDocument_OpenDocument() As Boolean

    ChangeScales.RemoveAll

    ChangeScales.AddItem "1/   500"
    ChangeScales.AddItem "1/  1000"
    ChangeScales.AddItem "1/  2500"
    ChangeScales.AddItem "1/  5000"
    ChangeScales.AddItem "1/ 10000"
    ChangeScales.AddItem "1/ 12500"
    ChangeScales.AddItem "1/ 25000"
    ChangeScales.AddItem "1/ 50000"
    ChangeScales.AddItem "1/100000"
    ChangeScales.AddItem "1/200000"

End Function

'相対パス設定
Private Sub SetRelativePaths_Click()

    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument

    pMxDocument.RelativePaths = True

    MsgBox "相対パスに設定しました"

End Sub