1、通过CAD、或是画图软件导出或是网上下载。把每个省的形状的坐标下载下来。
2、写VBA代码:
Sub 建立地图()
Dim i, j As Integer
Dim sha As Shape
i = 1
Dim a As FreeformBuilder
For Each cel1 In Range("B2:B" & Range("B65536").End(xlUp).Row + 1)
If cel1 = "" Then
ReDim p(cel1.Row - i - 1)
Set a = Sheet1.Shapes.BuildFreeform(msoSegmentCurve, Range("B" & i).Offset(1, 0), Range("B" & i).Offset(1, 1))
For Each cel2 In Range("B" & i + 2 & ":B" & cel1.Row - 1)
a.AddNodes msoSegmentCurve, msoEditingSmooth, cel2, cel2.Offset(0, 1)
Next
i = cel1.Row
Set sha = a.ConvertToShape
sha.Name = cel1.Offset(-1, -1)
Set a = Nothing
End If
Next
End Sub
2、写VBA代码:
Sub 建立地图()
Dim i, j As Integer
Dim sha As Shape
i = 1
Dim a As FreeformBuilder
For Each cel1 In Range("B2:B" & Range("B65536").End(xlUp).Row + 1)
If cel1 = "" Then
ReDim p(cel1.Row - i - 1)
Set a = Sheet1.Shapes.BuildFreeform(msoSegmentCurve, Range("B" & i).Offset(1, 0), Range("B" & i).Offset(1, 1))
For Each cel2 In Range("B" & i + 2 & ":B" & cel1.Row - 1)
a.AddNodes msoSegmentCurve, msoEditingSmooth, cel2, cel2.Offset(0, 1)
Next
i = cel1.Row
Set sha = a.ConvertToShape
sha.Name = cel1.Offset(-1, -1)
Set a = Nothing
End If
Next
End Sub