マップ スケールの設定

'スケール変更
Private Sub ChangeScales_SelectionChange(ByVal newIndex As Long)
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    
    Dim pActiveView As IActiveView
    Set pActiveView = pMxDocument.FocusMap
    
    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.MapScale = Right(ChangeScales.Item(newIndex), 6)
                
            End If
            Set pElement = pGraphContainer.Next
        Wend
    End If
    
    
    
    pActiveView.Refresh
    
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