Pagina 1 din 2
Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 1:58 pm
de jeleu
se pot face niste macro astfel incat sa execute find and replace, am diferite documente unde terbuie sa scot diacritice si stau de fiecare data cu find and replace si e cam obositor...
Later edit: am gasit nu reuseam sa fac pt ca in momentul cand inregistram incercam sa selectez cu mouseul nu din tastatura ca sa dau find and replace, se poate sterge cred...
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 2:14 pm
de Dr. Cloud
Daca tot ai deschis subiectul, hai sa bagam si un macro.
Eu scriu mereu cu diacritice, si mai ales cand nu trebuie
.
Asa ca am inregistrat un macro care sa faca aceste inlocuiri:
Cod: Selectaţi tot
Sub InlocuireDiacritice()
On Error GoTo err
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "î"
.Replacement.Text = "i"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "?"
.Replacement.Text = "a"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "â"
.Replacement.Text = "a"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "?"
.Replacement.Text = "t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "?"
.Replacement.Text = "s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Exit Sub
err:
MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"
End Sub
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 2:18 pm
de Dr. Cloud
Din pacate nu pot scrie cu diacritice, asa ca am exportat modulul *.bas.
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 2:38 pm
de jeleu
chiar ma intrebam de ce ai vrea sa ilocuiesti semnul intrebarii
) ms am reusit si eu sa fac si e cam aceeasi chestie.
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 3:03 pm
de Dr.Windows
Si ca sa mai "complic" situatia... ma bag si eu...
Cod: Selectaţi tot
Sub InlocuireCaractere()
srcString = "S,s,T,t,A,a,I,i,A,a"
dstString = "Ş,ş,Ţ,ţ,Ă,ă,Î,î,Â,â"
srcArray = Split(srcString, ",")
dstArray = Split(dstString, ",")
For i = 0 To UBound(srcArray)
Call ReplaceCHR(srcArray(i), dstArray(i))
Next i
End Sub
Sub ReplaceCHR(ByVal srcCHR As String, ByVal dstCHR As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = srcCHR
.Replacement.Text = dstCHR
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Unde "functia principala" este
InlocuireCaractere() si tot ce mai ramane de configurat sirul sursa
srcString si cel corespunzator "destinatie" -
dstString, in exemplul meu ambele sunt identice pentru ca din aceleasi motive ca si Alexx nu putem folosi diacritice pe acest forum...
Si daca vrei sa faceti vreo sicana unui coleg... puteti face o combinatie de "sursa" = a,b,c,d,e,f,g cu o "destinatie"=1,2,3,4,5,6,7
ATENTIE la corespondenta dintre cele 2 siruri, trebuie sa fie intotdeauna egale si aveti grija ce litere inlocuiti...
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 3:18 pm
de Dr. Cloud
Bun asa Lucian.
Mi-am actualizat si eu codul
Re: Macro pentru inlocuire diacritice
Scris: Mie Oct 07, 2009 4:54 pm
de jeleu
mult mai elegant ce a scris lucian
foarte frumos mersi
Re: Macro pentru inlocuire diacritice
Scris: Mar Oct 13, 2009 11:13 am
de Dr.Windows
jeleu scrie:mult mai elegant ce a scris lucian
foarte frumos mersi
Cu placere... si in cazul in care te intereseaza si ceva pentru Excel vezi mesajul de pe DrExcel -
VBA pentru eliminare diacritice (si alte caractere) mai ales ca este un macro "generic" care va functiona si pe Word si pe Excel...
Pentru cei care nu au cont si pe DrExcel (ar fi bine sa va faceti...
) dar aveti si codul pus mai jos:
Cod: Selectaţi tot
Sub InlocuireCaractere()
srcString = "S,s,T,t,A,a,I,i,A,a"
dstString = "S,s,T,t,A,a,I,i,A,a"
srcArray = Split(srcString, ",")
dstArray = Split(dstString, ",")
If Application.Name Like "*Excel*" Then
lcAppType = "XLS"
Else
If Application.Name Like "*Word*" Then
lcAppType = "DOC"
Else
MsgBox ("Tip aplicatie necunoscut!")
Return
End If
End If
For i = 0 To UBound(srcArray)
If lcAppType = "XLS" Then
Call ReplaceCHRXLS(srcArray(i), dstArray(i))
Else
If lcAppType = "DOC" Then
Call ReplaceCHRDOC(srcArray(i), dstArray(i))
End If
End If
Next i
End Sub
Sub ReplaceCHRDOC(ByVal srcCHR As String, ByVal dstCHR As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = srcCHR
.Replacement.Text = dstCHR
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub ReplaceCHRXLS(ByVal srcCHR As String, ByVal dstCHR As String)
Selection.Replace What:=srcCHR, Replacement:=dstCHR, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Re: Macro pentru inlocuire diacritice
Scris: Mar Oct 12, 2010 9:26 pm
de ccirtina
Putem folosi cuvinte in loc de litere?
srcString = "S,s,T,t,A,a,I,i,A,a"
dstString = "Ş,ş,Ţ,ţ,Ă,ă,Î,î,Â,â"
srcString = "Sus,mijloc,patrat"
dstString = "Jos,margine,rotund"
????
Re: Macro pentru inlocuire diacritice
Scris: Mar Oct 12, 2010 9:28 pm
de Dr. Cloud
Dap, poti folosi si cuvinte, dar sa ai grija la ordinea in care le pui si la cautare si la inlocuire. Asa ca in exemplul tau:
mare sa coresp. cu mic, mediu cu mare, etc.