Copie avec lien à finaliser
Bonjour,
Je suis au bout de mon programme, mais il me manque juste la touche finale aussi j'ai encore besoin de votre aide.
J'importe un fichier texte dans excel
je colore les mots clefs que j'ai décidé
et je voudrais à la fin que certains mots clefs apparaissent dans la feuille 2 (synthese) avec le lien hyperlink pointant vers la ligne ou l'expression recherchée apparaît dans la feuille 1.
Ci dessous ma macro,
et en pièce jointe un fichier txt qui s'intègre automatiquement à l'aide de ma macro.
Je vous en remercie par avance.
Et j'espère avoir été assez clair sinon je me ferais un devoir d'éclaircir les points ombrageux
Sub figuedi()
'
' figuedi Macro
'
Dim fich_txt As String
Dim fich_source As String
fich_source = ActiveWorkbook.Name
'Fixe le repertoire de recherche
ChDir "C:\Users\100011494\Desktop"
'demande a l'utilisateur de choisir un fichier
fich_txt = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
'ouverture du fichier txt
Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True
Columns("A:A").ColumnWidth = 27
Columns("C:D").ColumnWidth = 20
Columns("E:E").ColumnWidth = 6
Columns("F:F").ColumnWidth = 27
Columns("G:G").ColumnWidth = 37
' à réaliser plus tard un message box qui s'affiche à l'écran pour aller pointer directement sur les infos que l'on veut trouver
' des que j'aurais du temps je la ferais mais là ça suffit pour aujourd'hui
'petite boucle ou j'affecte à Nom une liste mot à colorer en vert
For Each Nom In Array("Power button event received", "startup COMPLETED", "RFM", "RTF", "RSX", "RTV", "MDM", "ButtonPressed")
Cells.Select
With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 52000
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Replace What:=Nom, Replacement:=Nom, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Next
' petite boucle comme tout à l'heure avec des nouveaux mots et la couleur jaune
For Each Nom In Array("startup INITIATED", "SHUTDOWN STARTED", "ButtonPressed: KC-01, 'Power / Standby'")
Cells.Select
With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Replace What:=Nom, Replacement:=Nom, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Next
' derniere boucle nouvelle liste de mot à colorer en rouge
For Each Nom In Array("CRASH", "RestartApplication")
Cells.Select
With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 70000
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Replace What:=Nom, Replacement:=Nom, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Next
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "synthese"
Dim sNomRech As String
Application.ScreenUpdating = False
'j'aurais voulu utiliser la variable fich_txt mais cela ne marche pas, je pense que c'est l'extension qui gène
'Set oShSource = Worksheets(fich_txt)
'du coup je suis obligé d'utiliser le nom du fichier en manuel
Set oShSource = Worksheets("log-voluson_000001")
Set oShDest = Worksheets("synthese")
sNomRech = "startup INITIATED "
oShSource.Select
Rows("1:1").Copy
oShDest.Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
iLue = 1
iEcr = oShDest.Range("A" & Rows.Count).End(xlUp).Row + 1
bFin = False
While Not bFin
If oShSource.Range("A" & iLue).Value = "" Then
bFin = True
Else
If oShSource.Range("G" & iLue).Value = sNomRech Then
oShSource.Rows(iLue).Copy
oShDest.Range("A" & iEcr).PasteSpecial xlPasteAll
Application.CutCopyMode = False
' c'est la ligne ci dessous qui me pose problème
'Worksheets("oShDest").Hyperlinks.Add Worksheets("oShDest").Range("A" & iEcr), "", "log-voluson_000001!("G" & iLue)
iLue = iLue +1
iEcr = iEcr + 1
Else
'ligne suivante
iLue = iLue + 1
End If
End If
Wend
Application.ScreenUpdating = True
MsgBox "Terminé !", vbExclamation
Set oShSource = Nothing
Set oShDest = Nothing
'
End Sub
Bonjour,
De cette façon :
With Worksheets("oShDest")
.Hyperlinks.Add .Range("A" & iEcr), "", "log-voluson_000001!G" & iLue
End WithMerci j'essaie desuite
Grrrrrr, c'est beaucoup mieux qu'avant la reférence iLue est bonne mais c'est le chemin qui n'est pas bon je pense
il me marque réference non valide alors dans le popup il pointe bien sur la bonne ligne
merci quand meme mais bon
suite demain faut que j'ailles au Sport.
nickel ça marche il fallait rajouter juste un truc :
Pour info :
With oShDest
.Hyperlinks.Add .Range("A" & iEcr), "", "'log-voluson_000001'!G" & iLue
End With
c'est les : ' qui font que le lien fonctionne
Merci encore de m'avoir mis sur la route !!!