麻辣家族討論版版 - Powered by Discuz! Board

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

作者: StanleyVic 時間: 2011-7-30 11:02 標題: (己解決!)~如何設定本WorkBook中,指定路徑位置超連結!

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

[attach]7185[/attach]

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

作者: GBKEE 時間: 2011-7-30 11:34

回復 1# StanleyVic
試試看

Sub Ex()
Dim E As Range
With ActiveSheet
For Each E In .[d4:d9]
.Hyperlinks.Add E, "", E.Text, E.Text, E.Text
Next
End With
End Sub

複製代碼

作者: StanleyVic 時間: 2011-7-30 12:22

回復 2# GBKEE

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

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

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

作者: GBKEE 時間: 2011-7-30 16:16

回復 3# StanleyVic
本身我現在的代碼都一直是在 "a工作表" 中運行. a工作表中的超結連~又要聲明多次?
可以了解一下嗎?

作者: StanleyVic 時間: 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

作者: GBKEE 時間: 2011-8-1 16:04

回復 5# StanleyVic
你這程式是sheet2(物件)的程式可使用關鍵字 Me => 物件本身, 及修改一下刪掉一些Activate 參考參考

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 Sheets.Count
With Sheets(WsName)
.Hyperlinks.Delete '可在此移除所有的Hyperlinks(超連結集合物件)刪除
For j = 2 To .Range("IV3").End(xlToLeft).Column
If .Cells(3, j).Value = "Out" Then
For K = 4 To .Range("A65536").End(xlUp).Row
If .Cells(K, j).Value <> "" And .Cells(K, j + 1) < 0 Then
'抄 data進去, 讀出對應路徑及超連結 ---------------
Cells(X, "A").Value = .Cells(K, 1)
Cells(X, "B").Value = .Cells(1, j - 2)
Cells(X, "C").Value = .Cells(K, j + 1)
Cells(X, "D").Value = .Name & "!" & .Cells(K, j + 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Me.Hyperlinks.Add Anchor:=.Cells(X, "D"), _
Address:="", _
SubAddress:=.Cells(X, "D").Value, _
TextToDisplay:=.Cells(X, "D").Value
X = X + 1
End If
Next K
End If
Next j
End With
Next WsName
'只保留最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

複製代碼

作者: StanleyVic 時間: 2011-8-2 10:54

回復 6# GBKEE

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

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

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

作者: GBKEE 時間: 2011-8-2 15:55

回復 7# StanleyVic
共用活頁簿的ThisWorkbook預設事件 Workbook_SheetChange 有輸入即存檔試試看

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Me.Save
End Sub

複製代碼

作者: StanleyVic 時間: 2011-8-2 22:09

回復 8# GBKEE

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)