Modifier une macro d'un userform

Bonsoir,

Dans le fichier joint, serait-il possible de lancer un userform qui permettrait de rechercher l'adresse d'un répertoire dans un ordinateur, de la copier et de remplacer l'adresse en cours dans la macro, à la ligne 2, colonne 21; ou encore, dans une fenêtre lancée depuis l'userform, d'insérer manuellement, l'adresse... qui sera automatiquement insérée en remplacement, dans la macro.

Pourriez-vous m'aiguiller? Merci

Sub ModifieAddresse()
    NvRepertoire = "G:\pcs\02. MAIN COURANTE PCS\04. LIENS HYPERTEXTES\" 'Adresse répertoire à modifier
    For Each h In ActiveSheet.Hyperlinks
        a = Split(Replace(h.Address, "\", "/"), "/")
        nf = a(UBound(a))
        h.Address = NvRepertoire & nf
        Next h
    End Sub

Bonsoir Curtis

Cela te va-t-il ??

A+

Merci Patty pour la réponse et la proposition utile.

A relire mon post, je n'ai pas été précis.

Il faudrait que la nouvelle adresse de répertoire, soit inscrite dans la macro elle-même.

Exemple :

NvRepertoire = "G:\pcs\02. MAIN COURANTE PCS\04. LIENS HYPERTEXTES\" deviendrait après sélection du répertoire

NvRepertoire = "C:\2018\..."

Merci pour l'effort.

Bonsoir

C'est bien ce que j'ai fait . J'ai refait du ménage et quand tu cliques sur ton rectangle bleu, tu choisis ton répertoire et il est repris directement dans la macro

Si cela ne va pas , remet moi les idées en place !!!

A+

Je n'ai pas été assez précis; je m'en excuse. Je vais être plus clair.

Dans une cellule active, je clique sur un bouton macro. Une forme est créée et une macro lui est affectée.

En cliquant sur cette forme, on choisit un fichier dans un répertoire qui est en bout de course, automatiquement copié dans le répertoire : "G:\pcs\02. MAIN COURANTE PCS\04. LIENS HYPERTEXTES\" , et un lien hypertexte faisant référence à cet objet copié, est lié à la forme.

Ce répertoire changera d'ici quelques mois et je ne serai plus dans mon emploi actuel. Mes collègue qui resteront en poste, sont frileux avec les ordinateurs.

Voici l'intégralité du code que j'utilise; bien que brouillon et redondant, il fait ce qu'on lui demande.

Sub MacroLienHyper()
    Dim finput As FileDialog
    Set finput = Application.FileDialog(msoFileDialogFilePicker)
    finput.InitialFileName = ActiveWorkbook.Path & "\"
    MsgBox "Veuillez sélectionnez le répertoire et le fichier de votre choix. Ok pour continuer."
    finput.Show
    If finput.SelectedItems.Count = 0 Then Exit Sub
    With ActiveSheet
        If Not finput Is Nothing Then
            .Hyperlinks.Add Anchor:=.Shapes(Application.Caller), Address:=finput.SelectedItems(1)
            CopyFile finput.SelectedItems(1)
            .Shapes(Application.Caller).OnAction = ""
            Call ModifieAddresse
        End If
    End With
    MsgBox "Le fichier a bien été copié dans le répertoire des liens hypertextes."
End Sub

Sub CopyFile(addrFileSource As String)
On Error GoTo suite
    Dim addrFileDest As String, fileX, sFile As String
    fileX = Split(addrFileSource, "\")
    sFile = fileX(UBound(fileX))
    With Application.FileDialog(msoFileDialogFolderPicker)
        MsgBox "A l'ouverture de la prochaine fenêtre, le répertoire de destination sera automatiquement selectionné; à nouveau, validez Ok."
        .InitialFileName = ("G:\pcs\02. MAIN COURANTE PCS\04. LIENS HYPERTEXTES\""")
        .Show
        If .SelectedItems.Count = 1 Then addrFileDest = .SelectedItems(1) Else Exit Sub
    End With
    FileCopy addrFileSource, addrFileDest & "\" & sFile
suite:
    Exit Sub
End Sub

Sub AjoutdeFormePourHyperlien()
    With ActiveSheet
        Call AjouterLignesCelluleActive
        Set forme = .Shapes.AddShape(msoShapeRectangle, ActiveCell.Left + 440, ActiveCell.Top + 10, 48, 26)
        forme.ShapeStyle = msoShapeStylePreset31
        forme.Select
        Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Lien"
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignLeft
        End With
        With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 255, 0)
            .Transparency = 0
            .Solid
        End With
        Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
        Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
        Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        With Selection.ShapeRange.TextFrame2.TextRange.Font
            .NameComplexScript = "Times New Roman"
            .NameFarEast = "Times New Roman"
            .Name = "Times New Roman"
        End With
'forme.Placement = xlMove
        forme.OnAction = "MacroLienHyper"
    End With
    Call Unselectshapes
End Sub

Sub ModifieAddresse()
    NvRepertoire = "G:\pcs\02. MAIN COURANTE PCS\04. LIENS HYPERTEXTES\"
    For Each h In ActiveSheet.Hyperlinks
        a = Split(Replace(h.Address, "\", "/"), "/")
        nf = a(UBound(a))
        h.Address = NvRepertoire & nf
        Next h
    End Sub

Sub AjouterLignesCelluleActive()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If ActiveCell.Column = 4 Then
        ActiveCell.Value = Chr(10) & ActiveCell.Value & Chr(10)
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

    Sub Unselectshapes()
        Dim rng As Range
        Set rng = ActiveCell
        rng.Activate
    End Sub

Bonjour,

Pour des raisons de sécurité liées au réseau sur lequel sont connectés mon ordinateur pro et celui de mes collègues, il semblerait que les paramètres de sécurité établis par l'administrateur réseau, ne permettraient de lancer la macro, objet de mon post.

Bonne journée.