Le portail francophone de la géomatique

'Select Tools / Customize
'Select the Commands Tab
'From the categories list (left) select UIControls
'Click on button New UIControl...
'Select UIButtonControl and click on button Create and Edit
'Paste the code below between lines Private Sub UIButtonControl1_Click() and End Sub
'Close the VBA Editor
'Select Tools / Customize
'Select the Commands Tab

'From the categories list (left) select UIControls
'From the commands list (right) select Normal.UIButtonControl1
'Drag the buttoncontrol to a toolbar (such as the Tools toolbar where the zoom and pan tools are)
'Right click on the buttoncontrol that was dragged to the toolbar and change the description and button image to something understandable
'Close the customize window

'In case that you have only 1 dataframe you will receive a message that you dont have enough dataframes
'In case you have only 2 dataframes the none active dataframe will receive the extent from the active dataframe (note that if the size and perhaps orientation of the dataframes differ, the extent will not be the same)
'In case you have more than 2 dataframes a list dialog is shown where you can select the dataframe that should be addapted. Select  in case you want to change th extent of all the dataframe to the active dataframe

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMaps As IMaps
Set pMaps = pMxDoc.Maps

'check if tool should work:
Dim intMapsCount As Integer
If pMaps.Count = 1 Then
  MsgBox There is only 1 dataframe available, tool will not have any effect...
  Exit Sub
Else
  intMapsCount = pMaps.Count
End If

'read the extent of focusmap
Dim pFocusMap As IMap
Set pFocusMap = pMxDoc.FocusMap
Dim pActiveView As IActiveView
Set pActiveView = pFocusMap
Dim pEnvFocusMap As IEnvelope
Set pEnvFocusMap = pActiveView.Extent

Dim pMap As IMap
Dim i As Integer

If intMapsCount = 2 Then
  If pMaps.Item(0) Is pFocusMap Then 
    Set pMap = pMaps.Item(1)
  Else
    Set pMap = pMaps.Item(0)
  End If
  Set pActiveView = pMap
  pActiveView.Extent = pEnvFocusMap
Else
  'offer a list where the user can select the dataframe that should be addapted
  Dim pListDlg As IListDialog
  Dim boolOK As Boolean
  Dim strChoice As String
  Dim pCurrentMap As IMap
  Set pListDlg = New ListDialog

  For i = 0 To intMapsCount - 1
    Set pCurrentMap = pMaps.Item(i)
    If pCurrentMap Is pFocusMap Then
      strChoice = i &  -  & pCurrentMap.Name &  (Active mapframe)
    Else
      strChoice = i &  -  & pCurrentMap.Name
    End If
    pListDlg.AddString strChoice
  Next i

  pListDlg.AddString
  boolOK = pListDlg.DoModal( Select Dataframe to be adapted , 0, Application.hWnd)
  If boolOK Then
    If pListDlg.Choice = intMapsCount Then
      'all dataframe
      For i = 0 To intMapsCount - 1
        Set pMap = pMaps.Item(i)
        Set pActiveView = pMap
        pActiveView.Extent = pEnvFocusMap
      Next i
    Else
      Set pMap = pMaps.Item(pListDlg.Choice)
      Set pActiveView = pMap
      pActiveView.Extent = pEnvFocusMap
    End If
  Else
    MsgBox No selection was made...
    Exit Sub
  End If
End If

'refresh
pMxDoc.ActiveView.Refresh