• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Tạo Map this Address

• Trang chủ

  • Thủ Thuật Access
  • Access Cơ Bản
  • Forms
  • [Hỏi] Tạo Map this Address
• Tạo Map this Address

• Tạo Map this Address

  Quynhhihi > 11-05-21, 12:57 PM

  Hiện tại mình đang viết code để tìm kiếm địa chỉ như sau
  
  
  Private Sub cmdMap_Click()
  Dim strAddress As String
  Dim strLink As String
  
  On Error GoTo myErr
  
      strAddress = Me.Address & ", " & Me.Industrial & ", " & Me.Dictrict & ", " & Me.City & ", " & Me.Country
      strLink = "http://www.google.com/maps?hl=en?&q= "
      Application.FollowHyperlink strLink & strAddress
     
  
  
  
  On Error GoTo 0
      Exit Sub
  myErr:
      Resume Next
  
  End Sub
  
  
  Nhưng khi tìm kiếm địa chỉ ở việt nam thì bị lỗi phông chữ, bạn nào có cách nào để tìm được tiếng việt không chỉ mình với ạ

• RE: Tạo Map this Address

  ongke0711 > 11-05-21, 04:27 PM

  Bạn truyền tham số lên Web thì bạn phải chuyển mã Unicode cho nó thành mã unicode cho Web.
  Bạn copy cái hàm này vào module:
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Private Const CP_UTF8 = 65001

#If VBA7 Then
  Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long _
    ) As Long
#Else
  Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long _
    ) As Long
#End If

Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
Dim lLength As Long
If UTF16 <> "" Then
    #If VBA7 Then
        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, 0, 0, 0, 0)
    #Else
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
    #End If
    sBuffer = Space$(lLength)
    #If VBA7 Then
        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, CLngPtr(StrPtr(sBuffer)), LenB(sBuffer), 0, 0)
    #Else
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), LenB(sBuffer), 0, 0)
    #End If
    sBuffer = StrConv(sBuffer, vbUnicode)
    UTF16To8 = Left$(sBuffer, lLength - 1)
Else
    UTF16To8 = ""
End If
End Function

Public Function URLEncode( _
      StringVal As String, _
      Optional SpaceAsPlus As Boolean = False, _
      Optional UTF8Encode As Boolean = True _
    ) As String

    Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
    Dim StringLen As Long: StringLen = Len(StringValCopy)

    If StringLen > 0 Then
        ReDim Result(StringLen) As String
        Dim I As Long, CharCode As Integer
        Dim Char As String, Space As String

        If SpaceAsPlus Then Space = "+" Else Space = "%20"

        For I = 1 To StringLen
            Char = Mid$(StringValCopy, I, 1)
            CharCode = Asc(Char)
            Select Case CharCode
            Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                Result(I) = Char
            Case 32
                Result(I) = Space
            Case 0 To 15
                Result(I) = "%0" & Hex(CharCode)
            Case Else
                Result(I) = "%" & Hex(CharCode)
            End Select
        Next I
        URLEncode = Join(Result, "")

    End If
End Function 


  
  
  
  - Sửa code lại:
  
  

  Mã PHP:

  strAddress = Me.Address & ", " & Me.Industrial & ", " & Me.Dictrict & ", " & Me.City & ", " & Me.Country
strAddress = URLEncode(strAddress, True) 
... 


• RE: Tạo Map this Address

  Quynhhihi > 12-05-21, 04:25 PM

  (11-05-21, 04:27 PM)ongke0711 Đã viết: Bạn truyền tham số lên Web thì bạn phải chuyển mã Unicode cho nó thành mã unicode cho Web.
  Bạn copy cái hàm này vào module:
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Private Const CP_UTF8 = 65001

#If VBA7 Then
  Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long _
    ) As Long
#Else
  Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long _
    ) As Long
#End If

Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
Dim lLength As Long
If UTF16 <> "" Then
    #If VBA7 Then
        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, 0, 0, 0, 0)
    #Else
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
    #End If
    sBuffer = Space$(lLength)
    #If VBA7 Then
        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, CLngPtr(StrPtr(sBuffer)), LenB(sBuffer), 0, 0)
    #Else
        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), LenB(sBuffer), 0, 0)
    #End If
    sBuffer = StrConv(sBuffer, vbUnicode)
    UTF16To8 = Left$(sBuffer, lLength - 1)
Else
    UTF16To8 = ""
End If
End Function

Public Function URLEncode( _
      StringVal As String, _
      Optional SpaceAsPlus As Boolean = False, _
      Optional UTF8Encode As Boolean = True _
    ) As String

    Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
    Dim StringLen As Long: StringLen = Len(StringValCopy)

    If StringLen > 0 Then
        ReDim Result(StringLen) As String
        Dim I As Long, CharCode As Integer
        Dim Char As String, Space As String

        If SpaceAsPlus Then Space = "+" Else Space = "%20"

        For I = 1 To StringLen
            Char = Mid$(StringValCopy, I, 1)
            CharCode = Asc(Char)
            Select Case CharCode
            Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                Result(I) = Char
            Case 32
                Result(I) = Space
            Case 0 To 15
                Result(I) = "%0" & Hex(CharCode)
            Case Else
                Result(I) = "%" & Hex(CharCode)
            End Select
        Next I
        URLEncode = Join(Result, "")

    End If
End Function 


  
  
  
  - Sửa code lại:
  
  

  Mã PHP:

  strAddress = Me.Address & ", " & Me.Industrial & ", " & Me.Dictrict & ", " & Me.City & ", " & Me.Country
strAddress = URLEncode(strAddress, True) 
... 


  
  Cảm ơn bạn nhé.
  Nhưng không hiểu sao mình đã copy y chang vậy lại hiển thị module lỗi?

• RE: Tạo Map this Address

  ongke0711 > 12-05-21, 04:55 PM

  Lỗi như thế nào bạn? hình ảnh, nội dung lỗi?
  
  - Cái hàm phải copy vô Standard module chứ không phải Form module.
  - Bạn dùng Access phiên bản nào?
• Bài trước Bài tiếp