Macro pentru inlocuire diacritice
Macro pentru inlocuire diacritice
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...
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
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:
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
Din pacate nu pot scrie cu diacritice, asa ca am exportat modulul *.bas.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: Macro pentru inlocuire diacritice
chiar ma intrebam de ce ai vrea sa ilocuiesti semnul intrebarii ) ms am reusit si eu sa fac si e cam aceeasi chestie.
-
- Moderator
- Mesaje: 4570
- Membru din: Vin Iul 31, 2009 7:32 am
Re: Macro pentru inlocuire diacritice
Si ca sa mai "complic" situatia... ma bag si eu...
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...
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
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
Bun asa Lucian.
Mi-am actualizat si eu codul
Mi-am actualizat si eu codul
Re: Macro pentru inlocuire diacritice
mult mai elegant ce a scris lucian foarte frumos mersi
-
- Moderator
- Mesaje: 4570
- Membru din: Vin Iul 31, 2009 7:32 am
Re: Macro pentru inlocuire diacritice
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...jeleu scrie:mult mai elegant ce a scris lucian foarte frumos mersi
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
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"
????
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
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.
mare sa coresp. cu mic, mediu cu mare, etc.