マップ スケールの設定

'スケール変更
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