यह पता लगाया। मुझे यकीन है कि अन्य लोग इसे पढ़ने जा रहे हैं जैसा मैंने आज किया। आपको दो मॉड्यूल (हाइपरलिंक निकालने के लिए एक और फ़ाइल पथ निर्देशिका का परीक्षण करने के लिए एक) की आवश्यकता होगी
मॉड्यूल 1 (हाइपरलिंक के लिए)
Function HLink(rng As Range) As String
'extract URL from hyperlink
'posted by C.F. Stotch! - shoutout to Richard K!
If rng(1).Hyperlinks.Count Then HLink = rng.Hyperlinks(1).Address
End Function
मॉड्यूल 2 (निर्देशिका परीक्षण के लिए)
Function FileOrDirExists(PathName As String) As Boolean 'used to test filepaths of commmand button links to see if they work - change their color if not working
'Macro Purpose: Function returns TRUE if the specified file
Dim iTemp As Integer
'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)
'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
'' '' '' और '' क्या है जब आप कमांड में बटन या कैसे आप चाहते हैं के माध्यम से, आप अपने जहाज में शामिल होने और इसे सक्रिय करने का प्रयास करेंगे। वर्कशीट सक्रिय होने पर मैंने इसे ऑटो चलाया है :) चीयर्स!
Private Sub TestFilesExist()
Dim xCheck As Integer
'starting in the 3rd row....
xCheck = 3
On Error GoTo 0
'Debug.Print Range("A" & xCheck).Value
While xCheck < 36
'xPather - checks if Z1 is a good path and then either highlights the actual cell in A column red if bad, or no fill if good.
Dim sPath As String
Dim XPather As String
'need a cell to put the hyperlink addresses into during the loop check as was not able to find the hyperlink address straight out of the cell containing the hyperlink. Extraction if you will. :)
ThisWorkbook.Sheets(1).Range("Z1").Value = "=HLink(A" & xCheck & ")"
XPather = ThisWorkbook.Sheets(1).Range("Z1").Value
Debug.Print XPather
'Tests if directory or file exists
If FileOrDirExists(XPather) = False Then
Range("A" & xCheck).Interior.ColorIndex = 3
Else
Range("A" & xCheck).Interior.ColorIndex = xlNone
End If
xCheck = xCheck + 1
Wend
End Sub
FileExist=Len(Dir(path))>0