乡镇镇谷歌地图怎么做MAPINFOW文件？     

使用方法：

1、需安装版google，打开google选择所需区域截图保存为JPG格式

2、在Excel中自建一个workbook，ALT+F11进入VBA界面，新建一个模块，将代码拷贝进去。
代码如下：

Option Explicit

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type BITMAP

    bmType As Long

    bmWidth As Long

    bmHeight As Long

    bmWidthBytes As Long

    bmPlanes As Integer

    bmBitsPixel As Integer

    bmBits As Long

End Type

Private Type PicInfo

    PicWidth As Long

    picHeight As Long

End Type

Private Function GetPicSize(lsPicName As String) As PicInfo

    Dim hBitmap As Long

    Dim res As Long

    Dim picHdl As Variant

    Dim bmp As BITMAP

    res = GetObject(LoadPicture(lsPicName).Handle, Len(bmp), bmp)      '取得BITMAP的结构

    GetPicSize.PicWidth = bmp.bmWidth

    GetPicSize.picHeight = bmp.bmHeight

    'DeleteObject picHdl

End Function

Sub GoogleEarth_COMAPI_GenRasterMap()

    Dim gei As Object

    Dim gec As Object

    Dim gep As Object

    Dim picW As Integer

    Dim picH As Integer

    Dim sFileName As String

    Dim vTmp As Variant

    On Error Resume Next

    Set gei = CreateObject("GoogleEarth.ApplicationGE")

    If Err.Number > 0 Then

        MsgBox "连接GoogleEarth失败！"

        Exit Sub

    End If

    sFileName = Application.GetSaveAsFilename("", "*.jpg,*.jpg")

    Set gec = gei.GetCamera(0)

    gec.Tilt = 0

    gec.Azimuth = 0

    If gec.Range > 100000 Then

        MsgBox "范围过大，将自动调整为100km！"

        gec.Range = 100000

    End If

    gei.SetCamera gec, 10

    gei.SaveScreenShot sFileName, 100

    Dim picS As PicInfo

    picS = GetPicSize(sFileName)

    'Dim pic As StdPicture

    'Set pic = StdFunctions.LoadPicture(sFileName)

    'picW = pic.Width

    'picH = pic.Height

    'Set pic = Nothing

    Dim iFNo As Integer

    iFNo = FreeFile()

    Open Left(sFileName, Len(sFileName) - 3) & "tab" For Output As #iFNo

    Print #iFNo, "!Table"

    Print #iFNo, "!version 300"

    Print #iFNo, "!charset WindowsSimpChinese"

    Print #iFNo, ""

    Print #iFNo, "Definition Table"

    vTmp = Split(sFileName, "")

    Print #iFNo, "  File """ & vTmp(UBound(vTmp)) & """"

    Print #iFNo, "  Type ""RASTER"""

    Set gep = gei.GetPointOnTerrainFromScreenCoords(-1, 1)

    Print #iFNo, "  (" & gep.Longitude & "," & gep.Latitude & ") (0,0) Label ""Pt 1"","

    Set gep = gei.GetPointOnTerrainFromScreenCoords(1, 1)

    Print #iFNo, "  (" & gep.Longitude & "," & gep.Latitude & ") (" & picS.PicWidth - 1 & ",0) Label ""Pt 2"","

    Set gep = gei.GetPointOnTerrainFromScreenCoords(-1, -1)

    Print #iFNo, "  (" & gep.Longitude & "," & gep.Latitude & ") (0" & "," & picS.picHeight - 1 & ") Label ""Pt 3"","

    Set gep = gei.GetPointOnTerrainFromScreenCoords(1, -1)

    Print #iFNo, "  (" & gep.Longitude & "," & gep.Latitude & ") (" & picS.PicWidth - 1 & "," & picS.picHeight - 1 & ") Label ""Pt 4"""

    Print #iFNo, "  CoordSys Earth Projection 1, 104"

    Print #iFNo, "  Units ""Degree"""

    Close #iFNo

    Set gei = Nothing

    Set gec = Nothing

    Set gep = Nothing

    MsgBox "OK, refer to " & sFileName

End Sub

3、运行——导入图片——完成后自动生成MAP图层。