Macro pentru inlocuire diacritice

Informatii despre cum se utilizeaza Microsoft Word 2003. Editare, formatare, automatizare de documente
jeleu
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Macro pentru inlocuire diacritice

Mesaj de jeleu » Mie Oct 07, 2009 1:58 pm

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...

Dr. Cloud
Mesaje: 3327
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr. Cloud » Mie Oct 07, 2009 2:14 pm

Daca tot ai deschis subiectul, hai sa bagam si un macro.
Eu scriu mereu cu diacritice, si mai ales cand nu trebuie :lol: .

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


Dr. Cloud
Mesaje: 3327
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr. Cloud » Mie Oct 07, 2009 2:18 pm

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.

jeleu
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Re: Macro pentru inlocuire diacritice

Mesaj de jeleu » Mie Oct 07, 2009 2:38 pm

chiar ma intrebam de ce ai vrea sa ilocuiesti semnul intrebarii :)) ms am reusit si eu sa fac si e cam aceeasi chestie.

Dr.Windows
Moderator
Moderator
Mesaje: 4570
Membru din: Vin Iul 31, 2009 7:32 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr.Windows » Mie Oct 07, 2009 3:03 pm

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 :lol:

ATENTIE la corespondenta dintre cele 2 siruri, trebuie sa fie intotdeauna egale si aveti grija ce litere inlocuiti...

Dr. Cloud
Mesaje: 3327
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr. Cloud » Mie Oct 07, 2009 3:18 pm

Bun asa Lucian.
Mi-am actualizat si eu codul :D

jeleu
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Re: Macro pentru inlocuire diacritice

Mesaj de jeleu » Mie Oct 07, 2009 4:54 pm

mult mai elegant ce a scris lucian :) foarte frumos mersi

Dr.Windows
Moderator
Moderator
Mesaje: 4570
Membru din: Vin Iul 31, 2009 7:32 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr.Windows » Mar Oct 13, 2009 11:13 am

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

ccirtina
Mesaje: 280
Membru din: Lun Oct 11, 2010 9:49 pm
Localitate: Craiova

Re: Macro pentru inlocuire diacritice

Mesaj de ccirtina » Mar Oct 12, 2010 9:26 pm

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"
????

Dr. Cloud
Mesaje: 3327
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesaj de Dr. Cloud » Mar Oct 12, 2010 9:28 pm

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.

Închis

Înapoi la “Intrebari despre Word 2003”