通过地址坐标在百度地图中标记

寒江隐居客

想请教下楼主及各位大侠，为什么用楼主excel链接的百度地图上没有正常的工具、标记、测距等功能呢？怎么样才能添加呢？

寒江隐居客

请问标记类型的图标怎么能改呢？非常感谢！！！

寒江隐居客

请问楼主，如果不想用默认的图标，如何自定义图标呢？

YZC51

学习楼主的代码！稍做改进，谢谢楼上的各位老师！
通过地址坐标在百度地图中标记
通过地址坐标在百度地图中标记-升级版.rar (167.23 KB, 下载次数: 471)

2016-7-13 15:46 上传

点击文件名下载附件

YZC51

~Cinderella~ 发表于 2014-12-11 14:41
你好，非常喜欢这个思路。。请教一个问题，当数据超过260条记录是显示的地图为什么会变成空白？将数据分开 ...

请测试14楼附件，数据应该超过260条记录！

寒江隐居客

YZC51 发表于 2016-7-13 15:47
学习楼主的代码！稍做改进，谢谢楼上的各位老师！
通过地址坐标在百度地图中标记

感谢升级版分享，精彩不断！

寒江隐居客

YZC51 发表于 2016-7-16 00:45
请测试14楼附件，数据应该超过260条记录！

请问美女楼主，模块1里面的三个过程用途是什么？本人初学者，看不懂哎
Sub NewTxt()
   ' Dim Arr, k%, Str1$

  Arr = Range("e2", [A65536].End(3)(2, 7))
' Arr = Range("a2", "k2")

    For k = 1 To UBound(Arr)
'Str = Str & vbLf & Join(Application.Index(Arr, k), " ") & vbCr
     '    Str1 = Str1 & vbLf & Join(Application.Index(Arr, k), ",")
   
       Str1 = Str1 & vbCrLf & Join(Application.Index(Arr, k), ",")
    Next

    Open ThisWorkbook.Path & "\退休.txt" For Output As #1
    Print #1, Str1
    Reset
End Sub


Sub test()
Dim ws As Worksheet
Dim rng As Range
For Each ws In ThisWorkbook.Worksheets
    Set rng = ws.UsedRange
    Dim r As Range, rr As Range, s$
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("d:\" & ws.Name & ".csv", True)
    For Each r In rng.Rows
        s = ""
        For Each rr In r.Cells
            s = s & rr.Value & ","
        Next
        a.writeline (s)
    Next
    a.Close
Next
End Sub

Sub NewCsv()
    Dim Sh As Worksheet
    Application.SheetsInNewWorkbook = 1
    Application.DisplayAlerts = False
    For Each Sh In Sheets
        Sh.UsedRange.Copy Workbooks.Add.ActiveSheet.[a1]
        ActiveWorkbook.SaveAs "D:\" & Sh.Name & ".txt", FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
    Next
    Application.DisplayAlerts = True
    Application.SheetsInNewWorkbook = 3
End Sub

寒江隐居客

YZC51 发表于 2016-7-16 00:45
请测试14楼附件，数据应该超过260条记录！

还望指教，感谢！

YZC51

寒江隐居客 发表于 2016-7-19 09:13
还望指教，感谢！

抱歉！借用他人的文件做的，忘记把无关代码删除。
具体用途不太清楚！

寒江隐居客

YZC51 发表于 2016-7-19 10:14
抱歉！借用他人的文件做的，忘记把无关代码删除。
具体用途不太清楚！

也就是说这三个过程是无关代码，可以删除。那么sheet3里面的这个过程是不是也是无关代码呢？看得有些晕。谢谢！

Sub NewTxt1()
    Dim Arr, k%, Str$

    Arr = Range("A1", [A65536].End(3)(1, 7))
    For k = 1 To UBound(Arr)
        Str = Str & vbCrLf & Join(Application.Index(Arr, k), ",")
    Next

    Open ThisWorkbook.Path & "\退休1.txt" For Output As #1
    Print #1, Str
    Reset
End Sub