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

peter460191

請問要如何自動在(A2~A10儲存格)每一個地址上加入Google地圖連結，且字型顏色皆不會變

下載 (59.27 KB)

2013-6-6 15:41

地址.rar (1.51 KB)

下載次數: 26

2013-6-6 15:42

stillfish00

回復 1# peter460191
試試看

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

複製代碼

peter460191

回復 2# stillfish00


   感謝 stillfish00 的指導，已經可以，會好好研究，非常謝謝您!

peter460191

回復 2# stillfish00


   請問 stillfish00
   若我要變更地址位置及數量要如何改程式，我試了好久都未能成功，請幫忙教導，感激不盡，謝謝您!

c_c_lai

回復  stillfish00


   請問 stillfish00
   若我要變更地址位置及數量要如何改程式，我試了好久都未 ...
peter460191 發表於 2013-6-7 12:06

你是指這個嗎？

1. '    請放置在 "工作表1" 程式區內。
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     With Target
   
4.         .Hyperlinks.Add Anchor:=Target, Address:="http://maps.google.com.tw/maps?q=" & Target
   
5.         .Style = "Normal"
   
6.     End With
   
7. End Sub

複製代碼

stillfish00

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

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

複製代碼

peter460191

回復 5# c_c_lai


   感謝 c_c_lai 您的指導，有試過了，但有的可以有的不行，問題是出在那裡，謝謝您!

peter460191

回復 6# stillfish00


    感謝stillfish00 指導，我再研究試試看

peter460191

回復 6# stillfish00


   請問 stillfish00
   若儲存格內的地址會隨機變動，但超連結只會記住第一個，請問有辦法隨儲存格內的地址變動，而地圖超連結也立即跟著變動嗎?
   謝謝您!

ML089

回復 7# peter460191


我測試10幾筆都可以
要注意，程式筆需放在該工作表程式區