www.Cursuri-Excel.ro     www.Cursuri-Access.ro     www.Cursuri-Powerpoint.ro     www.Cursuri-Outlook.ro     www.Cursuri-Word.ro     www.CursuriProject.ro    

Macro pentru inlocuire diacritice

Informatii despre cum se utilizeaza Microsoft Word 2003. Editare, formatare, automatizare de documente

Macro pentru inlocuire diacritice

Mesajde 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...
jeleu
 
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Re: Macro pentru inlocuire diacritice

Mesajde 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: 3329
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesajde 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.
Dr. Cloud
 
Mesaje: 3329
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesajde 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.
jeleu
 
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Re: Macro pentru inlocuire diacritice

Mesajde 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.Windows
Site Admin
Site Admin
 
Mesaje: 4493
Membru din: Vin Iul 31, 2009 7:32 am

Re: Macro pentru inlocuire diacritice

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

Bun asa Lucian.
Mi-am actualizat si eu codul :D
Dr. Cloud
 
Mesaje: 3329
Membru din: Mar Oct 02, 2012 11:19 am

Re: Macro pentru inlocuire diacritice

Mesajde jeleu » Mie Oct 07, 2009 4:54 pm

mult mai elegant ce a scris lucian :) foarte frumos mersi
jeleu
 
Mesaje: 22
Membru din: Joi Sep 24, 2009 2:23 pm

Re: Macro pentru inlocuire diacritice

Mesajde 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
Dr.Windows
Site Admin
Site Admin
 
Mesaje: 4493
Membru din: Vin Iul 31, 2009 7:32 am

Re: Macro pentru inlocuire diacritice

Mesajde 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"
????
ccirtina
 
Mesaje: 280
Membru din: Lun Oct 11, 2010 9:49 pm
Localitate: Craiova

Re: Macro pentru inlocuire diacritice

Mesajde 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.
Dr. Cloud
 
Mesaje: 3329
Membru din: Mar Oct 02, 2012 11:19 am

Următorul

Înapoi la Intrebari despre Word 2003

Cine este conectat

Utilizatorii ce navighează pe acest forum: Niciun utilizator înregistrat şi 2 vizitatori