[VBA] Αλλάξανε οι διευθύνσεις των υπερσυνδέσμων...

[nikolassor]

Γεια σας,
Για έναν παράξενο λόγο (που δεν έχω βρει ακόμα), αλλάξανε οι διευθύνσεις των hyperlink που είχα σε ένα συγκεκριμένο φύλλο. Βασικά παρέμεινε ο τελικός φάκελος της διαδρομής, αλλά άλλαξε ο δίσκος.! Μου τα πήγε όλα στο desktop μου. "C/users/desktop/φάκελός μου". Ενώ ήταν "F/φάκελός μου". Εντωμεταξύ αυτό έγινε μόνο σε ένα από τα φύλλα του βιβλίου και όχι και σε άλλα όπου έχω και άλλες ::? Οι υπερσυνδέσεις όλες δημιουργήθηκαν μέσω κώδικα και δεν είχα κανένα πρόβλημα μέχρι τώρα...
Παράξενο μου φάνηκε αλλά δεν βρήκα άκρη... Ενώ έχω το βιβλίο σε backup, θα μπορούσα να γυρίσω εκεί. Αλλά επειδή έχω πολλές αλλαγές να γίνουν, είναι αρκετά χρονοβόρο να το ξαναφέρω στην τωρινή του κατάσταση.

Είναι εφικτό να τρέξω κάποια μακροεντολή όπου θα τριμάρει τις διευθύνσεις και θα αλλάζει την αρχή της τωρινής διαδρομής σε αυτή που θέλω;
Θα πρέπει να διαβάσει όλες τις υπερσυνδέσεις και μετά να τις αλλάξει σαν κείμενο; Ή να πιάνει μία μία να την σβήνει αποθηκεύωντας την κατάληξη και μετά να την ξανα φτιάχνει με την σωστή διαδρομή;

Είναι περίπου στις 800 εγγραφές....
Αξίζει να το δοκιμάσω ή καλύτερα να πιάσω το backup και να ξανα αρχίσω την δουλειά πάλι;

Καμιά ιδέα;;

[kapetang]

Καλησπέρα

Νικόλα, μπορείς να χρησιμοποιήσεις τον παρακάτω κώδικα:

Sub EditHyperlink()

    Dim hLink As Hyperlink

    'Πατρικός του τελικού φακέλου που θα αλλάξει
    Const strOld As String = "C:\Users\Admin\Desktop\"

    'Νέος πατρικός του τελικού φακέλου
    Const strNew As String = "F:\"

    On Error GoTo errHandler
    If Dir(strOld, vbDirectory) <> "" And Dir(strNew, vbDirectory) <> "" Then
        Application.ScreenUpdating = False
        For Each hLink In ActiveSheet.Hyperlinks
            hLink.Address = Replace(hLink.Address, strOld, strNew)
            hLink.TextToDisplay = Replace(hLink.TextToDisplay, strOld, strNew)
        Next
        MsgBox "Οι αλλαγές ολοκληρώθηκαν"
    Else
        MsgBox "Κάποιος από τους πατρικούς φακέλους δεν υπάρχει"
    End If
exitSub:
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
    MsgBox "Error #" & vbCrLf & Err.Description
    Resume exitSub
End Sub

Αφού τον αντιγράψεις σε μια λειτουργική μονάδα (Module), πρόσθεσε στο φύλλο που περιέχει τους συνδέσμους, που θέλεις να αλλάξεις, ένα κουμπί και σύνδεσέ το με τη διαδικασία EditHypelink.

Στον κώδικα πιθανόν να χρειαστεί να αλλάξεις τον πατρικό φάκελο του τελικού φακέλου σου.

Φιλικά/Γιώργος

[nikolassor]

Φίλε Γιώργο με έσωσες!!!
Απλά έβαλα σε σχόλιο το σημείο που αλλάζει το όνομα, και έγινε ακριβώς αυτό που ήθελα!!
Θα μου έπαιρνε πολύ για να φανταστώ πως να το κάνω μιας και δεν ήξερα καν πως υπάρχει εντολή "replace" (άλλο ένα πολύ χρήσιμο καλό που έκανες!!)

Χίλια ευχαριστώ!,

[kapetang]

Νικόλα ευχαριστώ ....