請問要如何自動在每一個地址上加入Google地圖連結，且字型顏色皆不會變，謝謝您! - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 請問要如何自動在每一個地址上加入Google地圖連結，且字型顏色皆不會變，謝謝您!

返回列表下一主題上一主題發帖

請問要如何自動在每一個地址上加入Google地圖連結，且字型顏色皆不會變，謝謝您!

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

11^# 跳轉到 »

發表於 2013-6-10 14:14 | 只看該作者

回復 9# peter460191

隨儲存格內的地址變動，而地圖超連結也立即跟著變動嗎?

這樣就是和5#一樣，寫在 Change 事件中，
稍微改了一下，若還是不行請上傳附件。

' 請放置在 "工作表1" 程式區內。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, addrChange
Application.EnableEvents = False
Application.ScreenUpdating = False
Set addrChange = Intersect(Target, Range("A2:A10"))
If Not addrChange Is Nothing Then
For Each x In addrChange
If x.Value <> "" Then
Hyperlinks.Add Anchor:=x, Address:="http://maps.google.com.tw/maps?q=" & x.Value
x.Style = "Normal"
End If
Next
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

複製代碼

中學生 Rank: 2

帖子: 163
主題: 27
精華: 0
積分: 193
點名: 0
作業系統: winsows 10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
註冊時間: 2010-12-20
最後登錄: 2024-5-9

12^#

發表於 2013-6-11 09:10 | 只看該作者

回復 10# ML089

謝謝 ML089，我再試試看!

peter460191

中學生 Rank: 2

帖子: 163
主題: 27
精華: 0
積分: 193
點名: 0
作業系統: winsows 10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
註冊時間: 2010-12-20
最後登錄: 2024-5-9

13^#

發表於 2013-6-11 09:15 | 只看該作者

回復 11# stillfish00

謝謝 stillfish00 指導，我再研究看看，若不行再向您請教，
另外再向您請教一個問題，檔案的地址數量太多(約400個)，及又有其他的矩陣及VBA程式，會不會影響執行結果?

peter460191

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

14^#

發表於 2013-6-11 09:55 | 只看該作者

回復 13# peter460191
執行結果你可以自行嘗試比較看看就知道了。
至於執行效率會不會影響，這要看你的地址是如何"隨機生成"，
除非地址內容常常會400個、400個變動，又或者
其他VBA程式中常常去變動那些地址，
否則應該影響不大。

當然，自行備分後嘗試比較看看是最清楚的。

中學生 Rank: 2

帖子: 163
主題: 27
精華: 0
積分: 193
點名: 0
作業系統: winsows 10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
註冊時間: 2010-12-20
最後登錄: 2024-5-9

15^#

發表於 2013-6-11 11:16 | 只看該作者

回復 14# stillfish00

了解了!
謝謝您!
我再試試看。

peter460191

大學生 Rank: 4

帖子: 703
主題: 276
精華: 0
積分: 1005
點名: 1
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2011-6-30
最後登錄: 2024-5-29

16^#

發表於 2016-1-20 17:28 | 只看該作者

回復 14# stillfish00

老師，現在好像不能用了，地址會變成亂碼。

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

17^#

發表於 2016-1-20 18:58 | 只看該作者

回復 16# av8d
加一function

Function encodeURL(str As String)
With CreateObject("ScriptControl")
.Language = "JScript"
.AddCode "function encode(str) {return encodeURIComponent(str);}"
encodeURL = .Run("encode", str)
End With
End Function

複製代碼

9樓改為
Hyperlinks.Add Anchor:=x, Address:="http://maps.google.com.tw/maps?q=" & encodeURL(x.Value)

這樣試試

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

大學生 Rank: 4

帖子: 703
主題: 276
精華: 0
積分: 1005
點名: 1
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2011-6-30
最後登錄: 2024-5-29

18^#

發表於 2016-1-20 19:31 | 只看該作者

回復 17# stillfish00

可以了~謝謝老師~如果老師還有空~是否可以解答一下這題
http://forum.twbts.com/viewthrea ... ighlight=%A6a%B9%CF

靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。

返回列表下一主題上一主題