返回列表 上一主題 發帖

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

回復 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

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

TOP

回復 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

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

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

TOP

回復 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

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題