請問要如何自動在每一個地址上加入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

1^# 跳轉到 »

發表於 2013-6-6 20:55 | 顯示全部帖子

回復 1# peter460191
試試看

Sub TEST()
Dim r As Long, x
With Sheets("Sheet1")
r = .Cells(.Rows.Count, "A").End(xlUp).Row
If r > 1 Then
For Each x In .Range("A2:A" & r)
.Hyperlinks.Add Anchor:=x, Address:="http://maps.google.com.tw/maps?q=" & x.Value
Next
.Range("A2:A" & r).Style = "Normal"
End If
End With
End Sub

複製代碼

大學生 Rank: 4

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

2^#

發表於 2013-6-7 13:23 | 顯示全部帖子

回復 4# peter460191
2# 地址的位置是抓A2到A欄最後一筆
如果你要明確指定區域，改成下面這樣就是指定A2到A10

Sub TEST()
Dim x
With Sheets("Sheet1").Range("A2:A10")
For Each x In .Cells
.Parent.Hyperlinks.Add Anchor:=x, Address:="http://maps.google.com.tw/maps?q=" & x.Value
Next
.Style = "Normal"
End With
End Sub

複製代碼

大學生 Rank: 4

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

3^#

發表於 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: 4

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

4^#

發表於 2013-6-11 09:55 | 顯示全部帖子

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

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

大學生 Rank: 4

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

5^#

發表於 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)

這樣試試

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

靜思自在 : 不要小看自己，因為人有無限的可能。

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