Xin bản đồ các tỉnh Việt Nam trong file Excel

Ngày mai trời lại sáng · 29/8/21

batman1 đã viết:
Sửa chứ, các bài đều bàn về code của Covid mà.

Trong modWindowStyle có

Mã:

Private Sub SetStyleBit(style As Long, ByVal bit As Long, ByVal bSet As Boolean)

Sửa thành

Mã:

#If VBA7 Then Private Sub SetStyleBit(style As LongPtr, ByVal bit As Long, ByVal bSet As Boolean) #Else Private Sub SetStyleBit(style As Long, ByVal bit As Long, ByVal bSet As Boolean) #End If

Tóm lại ngoài khai báo style có thiếu sót thì khi CLICK trên sheet có lỗi là do có "xung đột".

Giải thích thêm cho những người thích Windows API hiểu.

1. Tại sao trong tập tin dùng OnTime không có lỗi khi CLICK trên sheet? OnTime dùng để chạy sub doi_mau. OnTime của VBA nên do Excel chạy, cứ sau 1 s thì Excel sẽ gọi doi_moi. Khi Excel bận thì dù 1 s đã qua thì nó cũng không gọi doi_moi mà làm xong các việc bận mới gọi doi_moi. Excel tự gọi nên nó làm chủ được tình huống. Không có xung đột gì ở đây.

2. Tại sao dùng SetTimer của Windows API thì lỗi khi CLICK trên sheet?
Ta phân tích dòng code

Mã:

ID = SetTimer(0, 0, 200, AddressOf TimerProc)

Dòng code trên có nghĩa là ta đã gọi hàm SetTimer của system Windows, kiểu như: báo cáo sếp (Windows), tôi đặt nhiệm vụ là cứ 200 ms thì thực hiện code của tôi, tức TimerProc, ở địa chỉ xyz trong bộ nhớ. Lúc đó system Windows sẽ tạo 1 "đồng hồ", cứ 200 ms sẽ gọi sub TimerProc. Tất nhiên 200 ms là thời gian mặc định. Khi 200 ms trôi qua mà đúng lúc system bận (ngoài process của ta còn vô vàn process khác trong system, bản thân system có những lúc bận) thì system sẽ gọi TimerProc vào lúc sau. Nhưng đây là nói về việc system bận, còn chuyện Excel lúc đó có bận hay không thì system không quan tâm, cứ 200 ms là gọi TimerProc. Hàm SetTimer trả về một giá trị được ghi nhớ trong biến ID. Khi cần "hủy" đồng hồ thì gọi KillTimer và truyền ID vào để hủy đồng hồ. Tại sao KillTimer không đủ để hủy đồng hồ mà lại phải truyền ID vào? Đơn giản là mỗi app có thể tạo nhiều đồng hồ do có nhu cầu. Khi muốn hủy 1 đồng hồ nào đấy mà chỉ cần gọi KillTimer không có tham số thì cụ thánh của system Windpows cũng chịu không biết "người ta" cần hủy đồng hồ nào. Vì thế mỗi đồng hồ được tạo bởi SetTimer sẽ được gán cho một con số định danh, và SetTimer khi tạo đồng hồ sẽ trả về con số định danh (ID) đó của đồng hồ được tạo. Khi cần hủy đồng hồ nào thì gọi KillTimer và truyền con số định danh (ID) của nó vào.
Khi chạy chương trình thì code và dữ liệu (data) sẽ được load vào bộ nhớ. Mọi chuyện sảy ra là sảy ra trong bộ nhớ. Sub TimerProc nằm đâu đó trong bộ nhớ. Trong trường hợp này TimerProc được gọi bởi system Windows chứ không bởi Excel. Vì mình có "khai báo" gì với Excel đâu mà nó biết khi nào phải gọi cái gọi là TimerProc. Để Windows có thể gọi TimerProc thì phải cung cấp cho Windows địa chỉ của TimerProc trong bộ nhớ. Windows biết TimerProc ở đâu thì cứ "đến giở" là gọi nó thôi. Ta cung cấp cho Windows địa chỉ trong RAM của TimerProc bằng hàm: AddressOf TimerProc sẽ trả về địa chỉ của TimerProc trong RAM. Khi đến giờ là Windows gọi TimerProc để thực thi. Nếu đúng lúc đó người dùng CLICK trên sheet thì code của Excerl cũng được thực thi (nếu vd. Excel phát hiện có Worksheet_SelectionChange thì code của Worksheet_SelectionChange sẽ được thực thi). 2 vị khác nhau cùng thực hiện việc của mình thì sảy ra "xung đột".

Hàm mà khi gọi một hàm nào đó của Windows API ta phải cung cấp cho Windows địa chỉ của nó, để Windows biết nó nằm ở đâu trong RAM để sau đó gọi nó, hàm đó được gọi là call back. TimerProc là một call back.

Hay quá code vẫn chạy êm như tiếng hát ru chú ạ.
Chú ơi cháu thấy có một vấn đề khi chỉ vào bản đồ (vùng màu xanh) vùng này có phải là Hà Nội không mà không xuất hiện thông tin tên thành phố chú nhỉ? Khi chỉ đến vùng khác thì hiển thị, hình ảnh là cháu đang chỉ vào Nam Định sau đó di chuyển về vùng xanh thông tin trên cái form hiển thị không thay đổi vẫn hiện Nam Định. Như vậy là có phải là vấn đề hay không chú nhỉ, cháu chưa hiểu cái món này:

batman1 · 29/8/21

3ii đã viết:
Hay quá code vẫn chạy êm như tiếng hát ru chú ạ.
Chú ơi cháu thấy có một vấn đề khi chỉ vào bản đồ (vùng màu xanh) vùng này có phải là Hà Nội không mà không xuất hiện thông tin tên thành phố chú nhỉ? Khi chỉ đến vùng khác thì hiển thị, hình ảnh là cháu đang chỉ vào Nam Định sau đó di chuyển về vùng xanh thông tin trên cái form hiển thị không thay đổi vẫn hiện Nam Định. Như vậy là có phải là vấn đề hay không chú nhỉ, cháu chưa hiểu cái món này:

View attachment 264992

À, cái này là do lỗi khi tạo bản đồ. Vùng xanh hình như là Hà Tây cũ. Cái vùng đỏ tiếp giáp vùng xanh hình như là Hà Nội cũ. Bây giờ 2 vùng tạo nên Hà Nội hiện hành.
Lấy vd. Quảng Ninh. Bạn click vào 1 đảo bất kỳ thì thấy hiện Quảng Ninh ở Name Box. Nhưng click lần nữa vẫn đảo đó thì lại là Freeform ... Tương tự với đảo khác của Quảng Ninh. Như vậy có nhiều Freeform ... khác nhau và chúng được Group với nhau tạo nên 1 vùng "lớn" có tên Quảng Ninh. Như vậy là Quảng Ninh (được tạo từ nhiều vùng nhỏ - freeform) được tạo rất chuẩn. Hà Nội không được tạo chuẩn như thế. Tôi nghĩ cần tạo lại cho chuẩn.

Ngày mai trời lại sáng · 29/8/21

batman1 đã viết:
À, cái này là do lỗi khi tạo bản đồ. .. Tôi nghĩ cần tạo lại cho chuẩn.

Ồ nghĩa là chú lại đau đầu thêm rồi,vậy làm phiền chú thêm một lần nữa.

Maika8008 · 29/8/21

Vẽ 1 tỉnh lâu lắm luôn. Không biết có thể cho vẽ nhanh hơn được không nhỉ?

batman1 · 29/8/21

3ii đã viết:
Ồ nghĩa là chú lại đau đầu thêm rồi,vậy làm phiền chú thêm một lần nữa.

Tập tin đính kèm là phiên bản mới nhất. Đã sửa các lỗi xuất hiện trong tập tin bài #48, và đã sửa lại bản đồ của Hà Nội.

Bạn kiểm tra lại và báo cáo nhé.

Ngày mai trời lại sáng · 29/8/21

batman1 đã viết:
Tập tin đính kèm là phiên bản mới nhất. Đã sửa các lỗi xuất hiện trong tập tin bài #48, và đã sửa lại bản đồ của Hà Nội.

Bạn kiểm tra lại và báo cáo nhé.

Báo cáo chú, cháu đã thử sau: mở loa to, di chuyển các ô, nhập liệu tô màu , thao tác, thậm trí tô cả màu bản đồ sang ánh nắng vàng rực rỡ... rồi trỏ di chuyển chuột nó vẫn đổ lại màu xanh
Sau đó update , màu vàng rực rỡ đã mất. Kết luận: kết quả hơn cả mong đợi, code hoạt động êm loa không phát ra tiếng binh bong, màn hình không hiển thị lỗi.
Đã nhìn thấy tên thủ đô "Hà Nội",cảm ơn chú rất nhiều, file này của chú cháu đã lưu vào thư mục yêu thích.

batman1 · 29/8/21

Maika8008 đã viết:
Vẽ 1 tỉnh lâu lắm luôn. Không biết có thể cho vẽ nhanh hơn được không nhỉ?

1. Tôi nghe chủ thớt nói là trong bảng tọa độ của tôi có cả Hà Tây (cũ). Nếu thế thì theo tôi hiểu Hà Nội mới là Hà Nội trong bảng + Hà Tây trong bảng.

2. Để vẽ mỗi tỉnh mà dùng bảng tọa độ của tôi thì hơi khó với các tỉnh gồm nhiều vùng tách biệt, vd. Quảng Ninh. Quảng Ninh có nhiều đảo, và mỗi đảo là 1 vùng riêng biệt. Từ bảng của tôi khó nhìn thấy nó có những vùng nào.

3. Do tôi viết code lọc tọa độ từ tập tin SVG nên vd. khi gặp Quảng Ninh thì trong quá trình lọc có thể biết đoạn vừa lọc là 1 vùng hoàn chỉnh hay không. Lúc đó thì vẽ luôn vùng. Sau đó nếu tỉnh hiện hành vẫn chưa kết thúc lộ trình thì lại lọc tọa độ cho vùng mới và vẽ vùng đó. Tức code của tôi vừa lọc tọa độ từ tập tin SVG vừa vẽ luôn từng tỉnh, và trong mỗi tỉnh vẽ từng vùng. Tất nhiên khi vẽ xong các vùng cho 1 tỉnh thì gộp (Group) chúng lại.

4. Vẽ 1 vùng hoàn chỉnh - đóng kín.
Giả sử có mảng 2 chiều, mỗi dòng là toạ độ 1 điểm, cột 1 là X, cột 2 là Y. Giả sử mảng có tên là points, số dòng - điểm là count thì hàm create_shape sẽ vẽ shape trên sheet sh, và trả về shape đó. Cách gọi

Mã:

mảng tên các vùng(i) = create_shape(sh, points, count, scale_, offsetX, offsetY).Name

Code của hàm

Mã:

Private Function create_shape(sh As Worksheet, arrPolygon() As Double, ByVal count As Long, ByVal scale_ As Double, ByVal offsetX As Double, ByVal offsetY As Double) As Shape
Dim r As Long
    For r = 1 To count
        arrPolygon(r, 1) = (arrPolygon(r, 1) + offsetX) * scale_
        arrPolygon(r, 2) = (arrPolygon(r, 2) + offsetY) * scale_
    Next r
    With sh
        With .Shapes.BuildFreeform(msoEditingCorner, arrPolygon(1, 1), arrPolygon(1, 2))
            For r = 2 To count
                .AddNodes msoSegmentLine, msoEditingAuto, arrPolygon(r, 1), arrPolygon(r, 2)
            Next r
            Set create_shape = .ConvertToShape
        End With
    End With
End Function

Với cách dùng BuildFreeform và vân vân mây mây thì rất nhanh. Tôi vẽ cả VN còn nhanh hơn bạn vẽ Hà Nội.

Tôi chọn Const scale_ = 1, offsetX = 100, offsetY = 150. scale_ càng nhỏ thì các tọa độ dùng để vẽ sẽ càng nhỏ so với toạ độ trong SVG, tức shape càng nhỏ. offsetX càng lớn thì shape trên sheet sẽ càng dịch xuống dưới, offsetY càng lớn thì shape sẽ càng dịch sang bên phải.

5. Tôi không vẽ lại Hà Nội. Trên bản đồ của chủ thớt đã có 2 vùng. Tôi chỉ sửa thôi.
Click vùng xanh ở bài 61 thì nhìn Name Box bạn sẽ thấy Hà Nội. Nhưng click lần nữa thì ở Name Box lại là b. Click tương tự vùng đỏ giáp với vùng xanh thì có Hà Nội, nhưng click lần nữa thì lại là a. a và b được gộp (Group) thành shape "lớn" có tên là Hà Nội. Nếu click 1 lần vào các đảo của Quảng Ninh thì ở Name Box luôn có Quảng Ninh. Nhưng click lần 2 thì là Freeform ...

Vấn đề ở chỗ với code

Mã:

Set obj = ActiveWindow.RangeFromPoint(pt.x, pt.y)

thì obj.Name lại không là Quảng Ninh mà là Freeform ..., còn với Hà Nội thì obj.Name là a hoặc b. Vì lý do này mà tôi phải mất công từ Freeform ... (Quảng Ninh và các tỉnh có nhiều vùng tương tự) suy ra tên tỉnh là Quảng Ninh bằng code

Mã:

shapeName = obj.Name    ' (A)
        If InStr(1, obj.Name, "Freeform", vbTextCompare) = 1 Then
            For Each shp In Sheet4.Shapes
                If shp.Type = msoGroup Then
                    For Each item In shp.GroupItems
                        If item.Name = shapeName Then
                            shapeName = shp.Name    ' (B)
                            timthay = True
                            Exit For
                        End If
                    Next item
                    If timthay Then Exit For
                End If
            Next shp
        End If

Tức nếu obj.Name không có đoạn đầu là "Freeform" thì đó cũng chính là tên nhóm (Group) - tên tỉnh (ở dòng (A)). Trong trường hợp ngược lại thì tên tỉnh được sửa lại ở dòng (B). Hiểu được đoạn code này thì sửa dễ dàng.

Ai muốn tự làm để kiểm nghiệm, thỏa trí tò mò thì làm như sau: click 2 lần (2 lần chứ không phải là đúp) vào Hà Nội cũ -> trong Name Box có a -> sửa thành vd. Freeform 999. Click 2 lần vào Hà Tây cũ -> trong Name Box có b -> sửa thành vd. Freeform 1000. Bây giờ obj.Name sẽ là Freeform 999 hoặc Freeform 1000 và tên tỉnh sẽ được trả về ở dòng (B).

Maika8008 · 29/8/21

@batman1 :
Tôi biết rồi:
Do tôi ghi macro, thấy nó cho msoSegmentCurve thì tôi dùng nó. Nhưng nay thấy code của bác tôi thay msoSegmentCurve bằng msoSegmentLine là vẽ nhanh liền.

P/S: Bác cho tôi xin dãy tọa độ của Hà Nội gộp với Hà Tây với bác!

batman1 · 29/8/21

Maika8008 đã viết:
@batman1 :
Tôi biết rồi:
Do tôi ghi macro, thấy nó cho msoSegmentCurve thì tôi dùng nó. Nhưng nay thấy code của bác tôi thay msoSegmentCurve bằng msoSegmentLine là vẽ nhanh liền.

P/S: Bác cho tôi xin dãy tọa độ của Hà Nội gộp với Hà Tây với bác!

Do tôi lọc từ SVG nên luôn có riêng rẽ Hà Tây và Hà Nội. Nếu bạn muốn thì bạn hãy thử gộp bằng tay: copy dữ liệu của Hà Tây (cột U:V) rồi paste nối tiếp vào Hà Nội (DS: DT). Để ý thấy là điểm đầu và điểm cuối của Hà Tây có tọa độ như nhau (x, y). Tức lộ trình là khép kín. Tương tự với Hà Nội.
Tôi không thử gộp dữ liệu nên không biết.

Maika8008 · 29/8/21

batman1 đã viết:
Do tôi lọc từ SVG nên luôn có riêng rẽ Hà Tây và Hà Nội. Nếu bạn muốn thì bạn hãy thử gộp bằng tay: copy dữ liệu của Hà Tây (cột U:V) rồi paste nối tiếp vào Hà Nội (DS: DT). Để ý thấy là điểm đầu và điểm cuối của Hà Tây có tọa độ như nhau (x, y). Tức lộ trình là khép kín. Tương tự với Hà Nội.
Tôi không thử gộp dữ liệu nên không biết.

Chép nối Hà Tây vào Hà Nội thì sẽ có 1 đường biên ở giữa, hơi kỳ. Nhưng tìm bằng mắt thường thì không biết bỏ điểm nào.

batman1 · 29/8/21

Maika8008 đã viết:
Chép nối Hà Tây vào Hà Nội thì sẽ có 1 đường biên ở giữa, hơi kỳ. Nhưng tìm bằng mắt thường thì không biết bỏ điểm nào.

Tôi nghĩ đường biên không đáng sợ lắm. Bạn thử vẽ cho Quảng Ninh xem sao. Tôi sợ là sẽ có các ĐƯỜNG NỐI.

2 vùng khác nhau có thể được ĐƯỢC NỐI với nhau (Code của bạn vẽ một mạch từ tọa độ đầu tới cuối nên khi đến điểm cuối của vùng 1 thì code có thể vẽ đường nối nó với điểm đầu của vùng 2 tiếp theo). Bạn thử vẽ Quảng Ninh xem có vô vàn đường nối ấy không. Chính vì thế trong code của mình tôi vẽ từng vùng riêng rẽ, sau mới Group chúng lại.

Còn chuyện đường biên thì ngồi dò bằng tay bằng mắt để bỏ bớt tọa độ thì tôi không có kiên nhẫn.

Maika8008 · 29/8/21

batman1 đã viết:
Tôi nghĩ đường biên không đáng sợ lắm. Bạn thử vẽ cho Quảng Ninh xem sao. Tôi sợ là sẽ có các ĐƯỜNG NỐI.

2 vùng khác nhau có thể được ĐƯỢC NỐI với nhau (Code của bạn vẽ một mạch từ tọa độ đầu tới cuối nên khi đến điểm cuối của vùng 1 thì code có thể vẽ đường nối nó với điểm đầu của vùng 2 tiếp theo). Bạn thử vẽ Quảng Ninh xem có vô vàn đường nối ấy không. Chính vì thế trong code của mình tôi vẽ từng vùng riêng rẽ, sau mới Group chúng lại.

Còn chuyện đường biên thì ngồi dò bằng tay bằng mắt để bỏ bớt tọa độ thì tôi không có kiên nhẫn.

Rồi thì cũng bỏ được các đoạn tọa độ chồng lấn để gộp Hà Tây vào Hà Nội. Tôi gửi lại file vẽ bản đồ.

Phụ Hồ Lên Phú Hộ · 29/8/21

Xin cho tôi hỏi, giờ tôi muốn lấy toạ độ của các quận của TP.HCM thì tôi có thể vào đâu lấy. Cám ơn các bác

batman1 · 29/8/21

Phụ Hồ Lên Phú Hộ đã viết:
Xin cho tôi hỏi, giờ tôi muốn lấy toạ độ của các quận của TP.HCM thì tôi có thể vào đâu lấy. Cám ơn các bác

Chả vào đâu cả. Tọa độ mà tôi đính kèm là cho 1 tỉnh, không chia ra thành quận, huyện. Bạn muốn có quận huyện thì tìm nguồn khác thôi.

Ngày mai trời lại sáng · 30/8/21

Maika8008 đã viết:
Rồi thì cũng bỏ được các đoạn tọa độ chồng lấn để gộp Hà Tây vào Hà Nội. Tôi gửi lại file vẽ bản đồ.

Ồ thì ra vậy, cái bản đồ là tự dùng chỉ số tọa độ để vẽ,bái phục các bác.
Nếu vẽ được như vậy thì bài này của chú BATMAN:

batman1 đã viết:
Tập tin đính kèm là phiên bản mới nhất. Đã sửa các lỗi xuất hiện trong tập tin bài #48, và đã sửa lại bản đồ của Hà Nội.

Bạn kiểm tra lại và báo cáo nhé.

Chú xem có thể kết hợp thêm chức năng vẽ lại bản đồ được không ạ, khi chiều cháu test co kéo rồi xóa bản đồ, xong phải tải lại file của chú,nếu có nút cập nhật lại ảnh bản đồ nữa thì hoàn hảo quá.

batman1 · 30/8/21

3ii đã viết:
Ồ thì ra vậy, cái bản đồ là tự dùng chỉ số tọa độ để vẽ,bái phục các bác.
Nếu vẽ được như vậy thì bài này của chú BATMAN:

Chú xem có thể kết hợp thêm chức năng vẽ lại bản đồ được không ạ, khi chiều cháu test co kéo rồi xóa bản đồ, xong phải tải lại file của chú,nếu có nút cập nhật lại ảnh bản đồ nữa thì hoàn hảo quá.

Nguyên tắc là: tất cả các dữ liệu, tập tin các loại (excel, ảnh, video, âm nhạc ...) mà khi mất đi thì không thể kiếm lại được (tải từ trên mạng nhưng link đã chết), hoặc phải mất rất nhiều công sức thời gian tiền bạc tìm kiếm để tải lại hoặc tự làm lại, tất cả những tập tin có tầm quan trọng như thế đều phải có bản sao. Nhiều khi 1 bản sao trên đĩa cứng chưa đủ mà còn cả bản sao ở DVD, USB, tùy vào tầm quan trọng mà ghi nhiều bản sao. Lý do rất đơn giản: có thể mất tập tin do sửa chữa và lưu nhầm, vi rút, DVD, USB hỏng.

Vậy thì hãy làm bản sao. Khi nhầm lẫn không phải vào GPE để tải lại. Nguyên tắc của tôi là thế.

Ngày mai trời lại sáng · 30/8/21

batman1 đã viết:
Nguyên tắc là: tất cả các dữ liệu, tập tin các loại (excel, ảnh, video, âm nhạc ...) mà khi mất đi thì không thể kiếm lại được (tải từ trên mạng nhưng link đã chết), hoặc phải mất rất nhiều công sức thời gian tiền bạc tìm kiếm để tải lại hoặc tự làm lại, tất cả những tập tin có tầm quan trọng như thế đều phải có bản sao. Nhiều khi 1 bản sao trên đĩa cứng chưa đủ mà còn cả bản sao ở DVD, USB, tùy vào tầm quan trọng mà ghi nhiều bản sao. Lý do rất đơn giản: có thể mất tập tin do sửa chữa và lưu nhầm, vi rút, DVD, USB hỏng.

Vậy thì hãy làm bản sao. Khi nhầm lẫn không phải vào GPE để tải lại. Nguyên tắc của tôi là thế.

Chú nói rất chuẩn, cháu sẽ ghi nhớ nguyên tác này.Chú đúng là siêu nhân BATMAN, 1h20 đêm rồi chú vẫn còn hoạt động.

batman1 · 30/8/21

3ii đã viết:
Chú nói rất chuẩn, cháu sẽ ghi nhớ nguyên tác này.Chú đúng là siêu nhân BATMAN, 1h20 đêm rồi chú vẫn còn hoạt động.

Ở Việt Nam 1:20 thì ở chỗ tôi mới là 20:20 ngày hôm trước.

Mà thôi, tôi viết cho bạn code tạo bản đồ từ dữ liệu tọa độ. Nếu các dữ liệu đó là của Nga thì vẽ bản đồ Nga, nếu dữ liệu là của Việt Nam thì vẽ bản đồ Việt Nam. Hiên trong tập tin đính kèm là dữ liệu của Việt Nam. Nếu cần vẽ bản đồ Nga thì từ dòng 1 và từ cột A phải nhập dữ liệu của Nga.

Nếu tên tỉnh ở A2 được tìm thấy ở dòng 1 của sheet vietnamHigh thì bản đồ tỉnh sẽ được vẽ. Nếu A2 rỗng thì vẽ bản đồ toàn Việt Nam. Nếu tên tỉnh ở A2 khác rỗng nhưng không tìm thấy được ở dòng 1 của sheet vietnamHigh, vd. tên nhập sai, thì A2 sẽ bị xóa và vẽ bản đồ toàn Việt Nam.

Nếu muốn vẽ bản đồ to nhỏ thì sửa scale_. Vd. scale_ = 2 thì bản đồ to gấp đôi. Nếu offsetX và offsetY tăng thì bản đồ sẽ dịch xuống dưới và dịch sang phải.

Trong tập tin dữ liệu cho Hà Nội đã được gộp từ Hà Nội cũ và Hà Tây cũ.

Code cũng đơn giản thôi. Toàn bộ code trong Module1

Mã:

Option Explicit

Sub create_map()
Const scale_ = 1
Const offsetX = 10
Const offsetY = 10
Dim firstRow As Long, lastRow As Long, chiso1 As Long, chiso2 As Long, curr_col As Long, k As Long, n As Long
Dim shp_name() As String, ten As String, Points(), shp As Shape
    ten = Sheet1.Range("A2").Value
    For k = 1 To 63
        If Sheet4.Cells(1, 2 * k - 1).Value = ten Then Exit For
    Next k
    If k > 63 Then
        Sheet1.Range("A2").Value = Empty    ' khong tim thay ten tinh nen xoa ten tinh
        chiso1 = 1
        chiso2 = 63
    Else
        chiso1 = k
        chiso2 = k
    End If
 
    For k = chiso1 To chiso2
        n = 0
        curr_col = 2 * k - 1
        firstRow = Rows.count
        Do While firstRow > 2
            lastRow = firstRow - 1
            lastRow = Sheet4.Cells(lastRow, curr_col + 1).End(xlUp).Row
            firstRow = Sheet4.Cells(lastRow, curr_col + 1).End(xlUp).Row
            n = n + 1
            ReDim Preserve shp_name(1 To n)
            Points = Sheet4.Range(Sheet4.Cells(firstRow, curr_col), Sheet4.Cells(lastRow, curr_col + 1)).Value
            shp_name(n) = create_shape(Sheet1, Points, UBound(Points, 1), scale_, offsetX, offsetY).Name
        Loop
        If UBound(shp_name) = 1 Then
            Set shp = Sheet1.Shapes(shp_name(1))
        Else
            Set shp = Sheet1.Shapes.Range(shp_name).Group
        End If
        With shp
            .Name = Sheet4.Cells(1, curr_col).Value
            .Fill.ForeColor.RGB = RGB(141, 180, 226)
            .Line.Weight = 0.25
            .Line.ForeColor.RGB = RGB(255, 255, 255)
            .Placement = xlMove
        End With
    Next k
End Sub

Private Function create_shape(sh As Worksheet, arrPolygon(), ByVal count As Long, ByVal scale_ As Double, ByVal offsetX As Double, ByVal offsetY As Double) As Shape
Dim r As Long
    For r = 1 To count
        arrPolygon(r, 1) = (arrPolygon(r, 1) + offsetX) * scale_
        arrPolygon(r, 2) = (arrPolygon(r, 2) + offsetY) * scale_
    Next r
    With sh
        With .Shapes.BuildFreeform(msoEditingCorner, arrPolygon(1, 1), arrPolygon(1, 2))
            For r = 2 To count
                .AddNodes msoSegmentLine, msoEditingAuto, arrPolygon(r, 1), arrPolygon(r, 2)
            Next r
            Set create_shape = .ConvertToShape
        End With
    End With
End Function

Ngày mai trời lại sáng · 30/8/21

batman1 đã viết:
Ở Việt Nam 1:20 thì ở chỗ tôi mới là 20:20 ngày hôm trước.

Mà thôi, tôi viết cho bạn code tạo bản đồ từ dữ liệu tọa độ. Nếu các dữ liệu đó là của Nga thì vẽ bản đồ Nga, nếu dữ liệu là của Việt Nam thì vẽ bản đồ Việt Nam. Hiên trong tập tin đính kèm là dữ liệu của Việt Nam. Nếu cần vẽ bản đồ Nga thì từ dòng 1 và từ cột A phải nhập dữ liệu của Nga.

Nếu tên tỉnh ở A2 được tìm thấy ở dòng 1 của sheet vietnamHigh thì bản đồ tỉnh sẽ được vẽ. Nếu A2 rỗng thì vẽ bản đồ toàn Việt Nam. Nếu tên tỉnh ở A2 khác rỗng nhưng không tìm thấy được ở dòng 1 của sheet vietnamHigh, vd. tên nhập sai, thì A2 sẽ bị xóa và vẽ bản đồ toàn Việt Nam.

Nếu muốn vẽ bản đồ to nhỏ thì sửa scale_. Vd. scale_ = 2 thì bản đồ to gấp đôi. Nếu offsetX và offsetY tăng thì bản đồ sẽ dịch xuống dưới và dịch sang phải.

Trong tập tin dữ liệu cho Hà Nội đã được gộp từ Hà Nội cũ và Hà Tây cũ.

Code cũng đơn giản thôi. Toàn bộ code trong Module1

Mã:

Option Explicit Sub create_map() Const scale_ = 1 Const offsetX = 10 Const offsetY = 10 Dim firstRow As Long, lastRow As Long, chiso1 As Long, chiso2 As Long, curr_col As Long, k As Long, n As Long Dim shp_name() As String, ten As String, Points(), shp As Shape ten = Sheet1.Range("A2").Value For k = 1 To 63 If Sheet4.Cells(1, 2 * k - 1).Value = ten Then Exit For Next k If k > 63 Then Sheet1.Range("A2").Value = Empty ' khong tim thay ten tinh nen xoa ten tinh chiso1 = 1 chiso2 = 63 Else chiso1 = k chiso2 = k End If For k = chiso1 To chiso2 n = 0 curr_col = 2 * k - 1 firstRow = Rows.count Do While firstRow > 2 lastRow = firstRow - 1 lastRow = Sheet4.Cells(lastRow, curr_col + 1).End(xlUp).Row firstRow = Sheet4.Cells(lastRow, curr_col + 1).End(xlUp).Row n = n + 1 ReDim Preserve shp_name(1 To n) Points = Sheet4.Range(Sheet4.Cells(firstRow, curr_col), Sheet4.Cells(lastRow, curr_col + 1)).Value shp_name(n) = create_shape(Sheet1, Points, UBound(Points, 1), scale_, offsetX, offsetY).Name Loop If UBound(shp_name) = 1 Then Set shp = Sheet1.Shapes(shp_name(1)) Else Set shp = Sheet1.Shapes.Range(shp_name).Group End If With shp .Name = Sheet4.Cells(1, curr_col).Value .Fill.ForeColor.RGB = RGB(141, 180, 226) .Line.Weight = 0.25 .Line.ForeColor.RGB = RGB(255, 255, 255) .Placement = xlMove End With Next k End Sub Private Function create_shape(sh As Worksheet, arrPolygon(), ByVal count As Long, ByVal scale_ As Double, ByVal offsetX As Double, ByVal offsetY As Double) As Shape Dim r As Long For r = 1 To count arrPolygon(r, 1) = (arrPolygon(r, 1) + offsetX) * scale_ arrPolygon(r, 2) = (arrPolygon(r, 2) + offsetY) * scale_ Next r With sh With .Shapes.BuildFreeform(msoEditingCorner, arrPolygon(1, 1), arrPolygon(1, 2)) For r = 2 To count .AddNodes msoSegmentLine, msoEditingAuto, arrPolygon(r, 1), arrPolygon(r, 2) Next r Set create_shape = .ConvertToShape End With End With End Function

Vậy là đầy đủ rồi, cảm ơn chú rất nhiều.
Múi giở của chú rất ấn tượng và đặc biệt, phương xa chú giữ gìn sức khoẻ.

Xin bản đồ các tỉnh Việt Nam trong file Excel

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

File đính kèm

Thành viên chính thức

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Facebook

Group