[發問] 能否依現有的VBA創出另一個VBA呢?

vpower

現有的VBA: http://naturefruit.myweb.hinet.net/map.xls
使用說明: 請點兩下B欄的儲存格(任意格).儲存格必須有值.

待完成的圖:
希望可以利用現有的VBA的原理.將待完成的圖內的A1~R1代入儲存格A欄~R欄.
將原有的點兩下儲存格更改為.在B1打入資料後按Enter或快捷鍵(如:Ctrl+F1).即可跳窗顯現.
如果跳窗顯現的部分沒辦法的話.請更改回點兩下B欄儲存格(任意格).儲存格必須有值.

感謝各位大大的幫忙.

Hsieh

回復 1# vpower


   這個問題癥結在於文字編碼轉換
以樓主提供圖片為例
搜尋關鍵字是"女"
網址列參數"女"被轉成utf-8編碼 %E5%A5%B3
在此請教各位先進
big5的文字該如何轉成utf-8代碼呢?
用google搜到api函數中
MultiByteToWideChar 和 WideCharToMultiByte 是有關轉碼的函數
請懂得使用此2函數的前輩指教
如何將
女→%E5%A5%B3

vpower

回復  vpower


   這個問題癥結在於文字編碼轉換
以樓主提供圖片為例
搜尋關鍵字是"女"
網址列參數 ...
Hsieh 發表於 2010-5-31 09:23

現有的VBA: http://naturefruit.myweb.hinet.net/map.xls
使用說明:
點2下B欄.如 A地 或 台北市忠孝東路1段20號
他都會另外開 http://maps.google.com.tw/ 網頁
網頁內的搜尋第一格就會放B欄位.第二格就會放C欄
我不曉得大大能不能利用程式碼如下:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 2 And Target.Value <> "" Then
        If Target.Range("B1") <> "" Then
            Cancel = True
            With CreateObject("InternetExplorer.Application")
                .Navigate "http://maps.google.com.tw/"
                Do While .Busy Or .ReadyState <> 4
                    DoEvents
                Loop
                .Document.all("d_d").innerText = Target
                .Document.all("d_daddr").innerText = Target.Range("B1")
                .Document.all("d_sub").Click
                .Visible = True
            End With
        End If
    End If
End Sub
對於程式碼我也麻煩人家寫的.也並非很了解.好像和PD961A大大講的一樣.要查他的原文.

搜尋關鍵字是"女"
就在我標明C1的部分.
能不能麻煩PD961A大大詳細講解一下現有的VBA的程式碼.
我唯一了解的就If Target.Column = 2 And Target.Value <> "" Then
他的2代表B欄.

Hsieh

回復 6# vpower


網頁架構不同,這種網頁的查詢
是將查詢參數直接寫到網址內
不過網頁的參數採用utf_8編碼
若excel儲存格內輸入big5必需轉成utf_8十六進位碼才能代入
在網路上找到api函數的WideCharToMultiByte函數
但轉出來就是跟網址列的不同
請前輩指導該如何修正程式

1. Private Const CP_UTF8 = 65001
   
2. 
   
3. 'Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
   
4. 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 cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
   
5. 
   
6. Public Function UTF8_Encode(ByVal Text As String) As String
   
7. 
   
8. Dim sBuffer As String
   
9. Dim lLength As Long
   
10. Dim mystr()
    
11. 
    
12. If Text <> "" Then
    
13. lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, 0, 0, 0, 0)
    
14. sBuffer = Space$(lLength)
    
15. lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
    
16. sBuffer = StrConv(sBuffer, vbUnicode)
    
17. UTF8_Encode = Hex(Asc(Left$(sBuffer, lLength - 1)))
    
18. Else
    
19. UTF8_Encode = ""
    
20. End If
    
21. End Function

複製代碼

uft_8.rar (7.17 KB)

下載次數: 7

2010-6-1 10:22

Hsieh

回復 4# Hsieh


    山不轉路轉,路不轉我轉
經閔版主提點,utf_8行不通,用utf_5就可直接用中文字
如附件 map.rar (12.04 KB)

下載次數: 11

2010-6-3 08:42

vpower

非常感謝您的用心..
可惜我閱讀權限不足..