返回列表 上一主題 發帖

[發問] (己解決!)~如何設定本WorkBook中,指定路徑位置超連結!

StanleyVic

帖子
47 
主題
6 
精華
0 
積分
74 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Macau 
註冊時間
2011-6-15 
最後登錄
2016-7-4 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-7-30 11:02 | 只看該作者

[發問] (己解決!)~如何設定本WorkBook中,指定路徑位置超連結!

本帖最後由 StanleyVic 於 2011-8-4 11:16 編輯



請問各位大大.
如上圖,本人想把,Column (D)中所顯示的 路徑 進行超連結至指定位置.
萬分謝謝~
收藏 分享
NeverTry , NeverNo !

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2011-7-30 11:34 | 只看該作者
回復 1# StanleyVic
試試看
  1. Sub Ex()
  2.     Dim E As Range
  3.     With ActiveSheet
  4.         For Each E In .[d4:d9]
  5.             .Hyperlinks.Add E, "", E.Text, E.Text, E.Text
  6.         Next
  7.     End With
  8. End Sub
複製代碼

TOP

StanleyVic

帖子
47 
主題
6 
精華
0 
積分
74 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Macau 
註冊時間
2011-6-15 
最後登錄
2016-7-4 
3#
發表於 2011-7-30 12:22 | 只看該作者
回復 2# GBKEE

謝謝你的指教..己經可以實現了我想要的東西. 其實在發問之前, 我己經試過 錄宏 內同你差不多, 但我試了好多次都不行, 現在明白
原因在於我缺了...." With 那一個工作表.. "

我有點亂 :
本身我現在的代碼都一直是在 "a工作表" 中運行.  a工作表中的 超結連~又要聲明多次?

怎也好, 以後我也會注意一下. 再次謝大大的幫助!
NeverTry , NeverNo !

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2011-7-30 16:16 | 只看該作者
回復 3# StanleyVic
本身我現在的代碼都一直是在 "a工作表" 中運行.  a工作表中的 超結連~又要聲明多次?
可以了解一下嗎?

TOP

StanleyVic

帖子
47 
主題
6 
精華
0 
積分
74 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Macau 
註冊時間
2011-6-15 
最後登錄
2016-7-4 
5#
發表於 2011-8-1 11:27 | 只看該作者
本帖最後由 StanleyVic 於 2011-8-1 11:34 編輯

回復 4# GBKEE

謝謝你的熱心幫助.本人新手.代碼寫得有點亂,讓你見笑..
是這樣的,本身己經在sheet2中執下這個動作. 代碼各方面我己經寫好,就是差那一段給搞亂了好久,最後我用錄,當時在MArco下.ok~可以.但放進去就不行.於是我發貼.才知.我欠了 With工作表 .  (不過怎也好. 也要再次向謝謝~)

Private Sub NegativeRecord_Click()

'續張型號工作表作運算----------------------------------------------------------
Dim WsName, N, i, j, K As Integer  '不同工作表
Dim X, Y, Z As Integer      '自身工作表的範圍
Dim Sh As Worksheet         'Dim(宣告變數為私用變數)  型態為 Worksheet(工作表)
   
'移除所有Sh(工作表)的Hyperlinks(超連結集合物件)刪除----------------------------
    For Each Sh In Sheets
        Sh.Hyperlinks.Delete
    Next

'先Delete所有舊Record!---------------------------------------------------------
X = 4: Y = Range("A65536").End(xlUp).Row
Range("A4:D" & Y).Hyperlinks.Delete
Range("A4:D" & Y).ClearContents

'設定所有型號Sheet中,以最Updata的方法計算因 Out 而引致的 負數Total 記錄------------
N = Worksheets.Count
    For WsName = 3 To N
        Sheets(WsName).Activate
        i = Sheets(WsName).Range("IV3").End(xlToLeft).Column
            For j = 2 To i
                If Sheets(WsName).Cells(3, j).Value = "Out" Then
                    For K = 4 To Sheets(WsName).Range("A65536").End(xlUp).Row
                       If Sheets(WsName).Cells(K, j).Value <> "" And Sheets(WsName).Cells(K, j + 1) < 0 Then
                           '抄 data進去, 讀出對應路徑 及 超連結 ---------------
                            Cells(X, "A").Value = Sheets(WsName).Cells(K, 1)
                            Cells(X, "B").Value = Sheets(WsName).Cells(1, j - 2)
                            Cells(X, "C").Value = Sheets(WsName).Cells(K, j + 1)
                            Cells(X, "D").Value = Sheets(WsName).Name & "!" & Sheets(WsName).Cells(K, j + 1). _
                            Address(RowAbsolute:=False, ColumnAbsolute:=False)
                                With Sheets(2)
                                    .Hyperlinks.Add Anchor:=.Cells(X, "D"), _
                                    Address:="", _
                                    SubAddress:=.Cells(X, "D").Value, _
                                    TextToDisplay:=.Cells(X, "D").Value
                                End With                           
                                     X = X + 1
                      End If
                    Next K
                End If
            Next j
    Next WsName
        
        Sheets(2).Activate
   
'只保留最UPdate資料--------------------------------------------
   
            For Z = Range("A65536").End(xlUp).Row To 4 Step -1
                    If Cells(Z, "B").Value = Cells(Z - 1, "B").Value Then
                        Rows(Z - 1).Delete
                    End If
            Next Z
            
    MsgBox ("負數資料己經全部顯示 !")

End Sub

20002.JPG (134.98 KB)

20002.JPG

NeverTry , NeverNo !

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-8-1 16:04 | 只看該作者
回復 5# StanleyVic
你這程式是sheet2(物件)的程式 可使用關鍵字 Me => 物件本身,  及修改一下刪掉一些Activate   參考參考
  1. Private Sub NegativeRecord_Click()
  2. '續張型號工作表作運算----------------------------------------------------------
  3. Dim WsName, N, i, j, K As Integer  '不同工作表
  4. Dim X, Y, Z As Integer      '自身工作表的範圍
  5. Dim Sh As Worksheet         'Dim(宣告變數為私用變數)  型態為 Worksheet(工作表)
  6. '移除所有Sh(工作表)的Hyperlinks(超連結集合物件)刪除----------------------------
  7. '    For Each Sh In Sheets
  8. '       Sh.Hyperlinks.Delete
  9. '   Next

  11. '先Delete所有舊Record!---------------------------------------------------------
  12. X = 4: Y = Range("A65536").End(xlUp).Row
  13. Range("A4:D" & Y).Hyperlinks.Delete
  14. Range("A4:D" & Y).ClearContents

  16. '設定所有型號Sheet中,以最Updata的方法計算因 Out 而引致的 負數Total 記錄------------
  17. 'N = Worksheets.Count
  18.     For WsName = 3 To Sheets.Count
  19.         With Sheets(WsName)
  20.             .Hyperlinks.Delete   '可在此 移除所有的Hyperlinks(超連結集合物件)刪除
  21.             For j = 2 To .Range("IV3").End(xlToLeft).Column
  22.                 If .Cells(3, j).Value = "Out" Then
  23.                     For K = 4 To .Range("A65536").End(xlUp).Row
  24.                        If .Cells(K, j).Value <> "" And .Cells(K, j + 1) < 0 Then
  25.                            '抄 data進去, 讀出對應路徑 及 超連結 ---------------
  26.                             Cells(X, "A").Value = .Cells(K, 1)
  27.                             Cells(X, "B").Value = .Cells(1, j - 2)
  28.                             Cells(X, "C").Value = .Cells(K, j + 1)
  29.                             Cells(X, "D").Value = .Name & "!" & .Cells(K, j + 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
  30.                             Me.Hyperlinks.Add Anchor:=.Cells(X, "D"), _
  31.                                     Address:="", _
  32.                                     SubAddress:=.Cells(X, "D").Value, _
  33.                                     TextToDisplay:=.Cells(X, "D").Value
  34.                             X = X + 1
  35.                       End If
  36.                     Next K
  37.                 End If
  38.             Next j
  39.         End With
  40.     Next WsName
  41. '只保留最UPdate資料--------------------------------------------
  42.             For Z = Range("A65536").End(xlUp).Row To 4 Step -1
  43.                     If Cells(Z, "B").Value = Cells(Z - 1, "B").Value Then
  44.                         Rows(Z - 1).Delete
  45.                     End If
  46.             Next Z
  47.     MsgBox ("負數資料己經全部顯示 !")
  48. End Sub
複製代碼

TOP

StanleyVic

帖子
47 
主題
6 
精華
0 
積分
74 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Macau 
註冊時間
2011-6-15 
最後登錄
2016-7-4 
7#
發表於 2011-8-2 10:54 | 只看該作者
回復 6# GBKEE

    HOHO~~感謝大大的教導..(學習.學習了~~)

關於我這個文件,現在我又遇到一些新的問題:
1. 如果一個Excel 要用於共享多人使用方面, 就如我這個 "倉儲型號.xls " 內包括VBA寫的功能, 錄入資料 + 檢視 / 查找 + 輸出欠貨的數據. 等等小小代碼.請問大大你對我以下方法有何建議呢?
   一), 如果我設定每1分鐘 或 30秒 就自動SAVE一次作刷新,
   二), 先Save第一次, 再過行vba ,再save 第二次,
       (第一次成為刷新別人的數據, 第二次作為自己的數據保儲)

因為我只想到用 Thisworkbook +  save 的方式,  還有其他的方法想可以解決因共享大家爭入DATA 而引起的沖突,及 資料不更新,而引致查找不到別人的新數據!!
NeverTry , NeverNo !

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2011-8-2 15:55 | 只看該作者
回復 7# StanleyVic
共用活頁簿的ThisWorkbook預設事件 Workbook_SheetChange 有輸入即存檔 試試看
  1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  2.         Me.Save
  3. End Sub
複製代碼

TOP

StanleyVic

帖子
47 
主題
6 
精華
0 
積分
74 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Macau 
註冊時間
2011-6-15 
最後登錄
2016-7-4 
9#
發表於 2011-8-2 22:09 | 只看該作者
回復 8# GBKEE


    想不出還有這個方法...強!!
NeverTry , NeverNo !

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題