Remplacer texte par valeur cellule

YANOU · 9 Janvier 2017

Bonjour à tous.
Je veux rechercher/remplacer "Dossier type" (dans les Cellules C3 à C6) par la valeur de ma cellule E3
Pour l'instant, j'en suis à :

Code:

Sub Rempacer()
'
' Rempacer Macro
'

'
    Range("C3:C6").Select
    Selection.Replace What:="Dossier type", Replacement:="2", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
End Sub

Pour l'instant, j'ai juste mis "2" dans ma formule pour faire fonctionner ma macro correctement.
Je n'arrive pas à trouver le code pour cibler la valeur "2" de ma cellule E3.
Merci pour votre aide.

Calvus · 11 Janvier 2017

Re,

Comme ceci probablement.

A+

Dranreb · 11 Janvier 2017

Vous pouvez peut être vous orienter vers cette solution ?

VB:

Option Explicit

Sub Macro1()
Dim LienOrg As String, NouveauLien As String, Spl() As String
LienOrg = ThisWorkbook.LinkSources(xlExcelLinks)(1)
Spl = Split(LienOrg, "\")
Spl(5) = Feuil1.[E3].Value
NouveauLien = Join(Spl, "\")
If MsgBox("Voulez vous changer le lien ci après par celui indiqué en dessous ? :" _
   & vbLf & LienOrg & vbLf & NouveauLien, vbYesNo + vbQuestion, "Confirmation changement dossier") = vbNo Then Exit Sub
ThisWorkbook.ChangeLink Name:=LienOrg, NewName:=NouveauLien, Type:=xlExcelLinks
End Sub

YANOU · 11 Janvier 2017

J'ai essayé de modifier la dernière macro de Calvus pour "coller" à mon projet, mais cela ne fonctionne pas...
Merci pour votre aide.

Calvus · 11 Janvier 2017

Désolé Yanou, mais vous donnez les informations par bribes.
Alors je ne sais plus moi. Où est passée la cellule E3 ?
C'est maintenant B9 ??
Je ne peux passer du temps à essayer de déchiffrer ce qui vous parait évident.
Revenez quand vous aurez un fichier ou un modèle définitif, avec les explications adéquates.

A+

Dranreb · 11 Janvier 2017

N'oubliez pas ma solution, aussi: elle est plus sûre.
Bien sûr s'il y a plusieurs liens il faut l'adapter un tout petit peu: chercher le premier qui commence par "\\" par exemple.
Comme ça :

VB:

Sub ChangerLien()
Dim Liens(), N As Long, LienOrg As String, NouveauLien As String, Spl() As String
Liens = ThisWorkbook.LinkSources(xlExcelLinks)
For N = 1 To UBound(Liens)
   If Left$(Liens(N), 2) = "\\" Then LienOrg = Liens(N): Exit For
   Next N
If LienOrg = "" Then MsgBox "Aucun lien ""\\…"" trouvé", vbCritical, "Changer Lien": Exit Sub
Spl = Split(LienOrg, "\")
Spl(5) = Feuil2.[B3].Value
NouveauLien = Join(Spl, "\")
If MsgBox("Voulez vous changer le lien ci après par celui indiqué en dessous ? :" _
   & vbLf & LienOrg & vbLf & NouveauLien, vbYesNo + vbQuestion, "Confirmation changement dossier") = vbNo Then Exit Sub
ThisWorkbook.ChangeLink Name:=LienOrg, NewName:=NouveauLien, Type:=xlExcelLinks
End Sub

YANOU · 11 Janvier 2017

Je pensais vraiment avoir les capacités d'adapter votre code à mon projet et je suis sincèrement désolé d'avoir eu besoin de continuer ce poste et de prendre encore un peu de votre temps.

Pour les explications :
Le texte "Dossier type" (cellules B9 à B22) est à remplacer par le contenu de la cellule B7.

Merci encore pour votre aide.

Dranreb · 11 Janvier 2017

Bon. Y a trop de bazar dans votre programmation d'application, je ne vais pas y toucher.
Alors, dans un module standard mettez :

VB:

Option Explicit

Sub ChangerLien(ByVal Début As String, ParamArray Élé() As Variant)
Dim Liens(), N As Long, P As Long, LienOrg As String, NouveauLien As String, Spl() As String
Liens = ThisWorkbook.LinkSources(xlExcelLinks)
For N = 1 To UBound(Liens)
   If Liens(N) Like Début & "*" Then LienOrg = Liens(N): Exit For
   Next N
If LienOrg = "" Then MsgBox "Aucun lien ne commence par """ & Début & """.", vbCritical, "Changer Lien": Exit Sub
Spl = Split(LienOrg, "\")
For P = LBound(Élé) To UBound(Élé) Step 2: Spl(Élé(P)) = Élé(P + 1): Next P
NouveauLien = Join(Spl, "\")
If MsgBox("Voulez vous changer le lien ci après par celui indiqué en dessous ? :" _
   & vbLf & LienOrg & vbLf & NouveauLien, vbYesNo + vbQuestion, "Confirmation changement dossier") = vbNo Then Exit Sub
On Error Resume Next
ThisWorkbook.ChangeLink Name:=LienOrg, NewName:=NouveauLien, Type:=xlExcelLinks
If Err Then MsgBox "Err." & Err.Number & " en tentant de changer en """ & NouveauLien & """ le lien """ & LienOrg & """." _
  & vbLf & Err.Description, vbCritical, "Confirmation changement lien"
End Sub

Et à l'endroit où vous voulez changer toutes les cellule se référant à un certain classeur, appelez cette procédure sur ce modèle :

VB:

Sub test()
ChangerLien "\\srvpcvs01\PCVS\AFFAIRES", 5, "15500"
End Sub

En remplaçant évidemment "15500" par l'expression range .Value de la cellule contenant le terme à mettre.

S'il y a plusieurs choses à changer, vous pouvez toutes les spécifier derrière en alternant position du mot dans la suite '\…\' et nouvelle valeur.

Une fois le processus bien au point, vous pourrez, bien sûr, supprimer ou au moins mettre en commentaire l'émission du message de confirmation.

Calvus · 11 Janvier 2017

Re,

Yanou, est ce que la solution de Dranreb répond à votre problématique ?

YANOU · 12 Janvier 2017

Bonjour Calvus et Dranreb.
Je n'ai pas pris le temps d'insérer/modifier la macro de Dranreb pour la faire tourner dans mon classeur.
Mais, outre le fait de faire tourner la macro, j'essaie avant tout de la décortiquer pour comprendre son fonctionnement.
La macro de Calvus me semble plus "digeste" pour mon niveau (j'ai d'ailleurs passé du temps pour tenter de la modifier, je ne pense pas être très loin du résultat, mais...).
Si vous avez encore un peu de temps Calvus.

Code:

Sub Remplacer()
If val1 <> val2 Then
If [B9] Like "Dossier*" Then
Range("B9:B22").Select
     Selection.Replace What:="Dossier type", Replacement:=[B7].Value, LookAt:=xlPart _
         , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
         ReplaceFormat:=True
Else
Cells(9, 2) = Replace(Cells(9, 2), [Left(B9,Find(" ",B9))], [B7] & " ")
Cells(22, 2) = Replace(Cells(22, 2), [Left(B22,Find(" ",B22))], [B7] & " ")
End If
End If
val1 = [B7].Value
End Sub

- La première cellule contenant "Dossier type" est la cellule B9
- La modification est à faire de la cellule B9 à B22
- Le remplacement de "Dossier type" par la valeur de la cellule B7
- Remplacement case B9 par B7 [Cells (9,2)] jusqu'à B22 [Cells (22,2)]
Merci pour votre aide.

Dranreb · 12 Janvier 2017

Bonjours
Mais Bon sang ! Il me semble quand même qu'on ne peux pas du tout faire ça comme ça !
Ou alors on ne peux le faire qu'une fois, et impossible de changer de classeur source par la suite puisqu'il n'y aura plus de formule avec "Dossier type" ! D'où aucun intérêt que la même macro puisse s'exécuter chaque fois que n'importe quoi à lieu, en fait ! Ou alors je n'ai rien compris ?
Tandis que si, comme je le croyais, un seul classeur du réseau est lié par des formules, on peut toujours reconnaître cette liaison à des parties fixes de son chemin et modifier celui ci dans ses parties variables.

Dranreb · 12 Janvier 2017

Remarque :
Ça revient à changer toutes ces formules par menu Données, groupe Connexions, commande Modifier les liens, bouton Modifier la source.

Calvus · 13 Janvier 2017

Bonjour Yanou, Dranreb, le Forum,

Yanou, j'ai à nouveau passé beaucoup de temps sur le fichier, mais sans succès.
Le problème vient des liens et je n'ai pas su faire.
Je pense donc que la solution de Dranreb est beaucoup mieux adaptée.
Je pense donc que vous arriverez à votre résultat si Dranreb veut bien vous expliquer la procédure.
Désolé de ne pouvoir faire plus.
Cdt

YANOU · 16 Janvier 2017

Bonjour Calvus, Dranreb, le Forum,
Merci pour votre aide et le temps passé sur mon problème.
Je n'ai pas les compétences pour mettre à jour le code de Dranreb, mais mon fichier fonctionnait sans avant (Rechercher/Remplacer...), je vais continuer ainsi.
Encore merci à vous et longue vie au forum.

Dranreb · 16 Janvier 2017

Bonjour.
J'ai fourni une procédure qu'il n'y a pas lieu de à mettre à jour puisqu'on lui indique en paramètre ce qu'elle a à faire.
Exemple d'utilisation :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valeur
If Target.CountLarge > 1 Then Exit Sub
Valeur = Target.Value
If Target.Address = "$B$3" Then
   Application.ScreenUpdating = False
   Sheets("Descriptif réparation").Visible = Valeur = "Réparation"
   Sheets("Descriptif modification").Visible = Valeur = "Modification"
   Sheets("Décla Conf DESP").Visible = Valeur = "Composant" Or Valeur = "DESP"
ElseIf Target.Address = "$B$7" Then
   ChangerLien "\\", 5, Valeur ' Remplace ce qui se trouve après le 5ième "\" dans le lien commençant par "\\" par la valeur de la cellule.
   End If
End Sub

YANOU · 16 Janvier 2017

Bonjour Dranreb.
En collant votre code , aucune macro ne tourne...
Merci pour votre aide.

Remplacer texte par valeur cellule

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums