Rulare macro pe mai multe fisiere

Închis
Apostolu
Mesaje: 285
Membru din: Joi Aug 20, 2009 4:05 pm

Rulare macro pe mai multe fisiere

Mesaj de Apostolu » Joi Ian 30, 2014 12:49 pm

Operatiile repetitive sunt plictisitoare. :)
Sa presupunem un director cu 10 fisiere .doc si necesitatea de a rula xx mici macro pe toate cele 10 fisiere.
Pentru ca presupun niste complicatii mai mari la rularea tuturor macrourilor pe toate fisierele, un prim pas ar fi rularea fiecarui macro pe toate cele ... 10 fisiere.
Cum se poate realiza asta ?

XP, Ofiice 2003.

alcoool2
Mesaje: 969
Membru din: Mie Dec 15, 2010 4:25 pm

Re: Rulare macro pe mai multe fisiere

Mesaj de alcoool2 » Joi Ian 30, 2014 1:24 pm

Salut!
Inprincipiu trebuie sa creezi un alt macro care sa acceseze toate fisierele tale si sa ruleze si macrourile deja existente pentru fiecare document (sar putea sa fie necesar sa fie modificate si macrourile deja existente pentru a lucra intr-un mod generic, adica sa se muleze pe toate diferentele pe care le ai tu in fisier). Daca ai doar 10 fisiere nu cred ca s-ar merita efortul.
Oricum inceputul este in codul ce urmeaza:

Cod: Selectaţi tot

Set wordapp = CreateObject("word.Application")


    wordapp.documents.Open "C:\Documents and Settings\anitao\My Documents\alo2004.doc"
asa accesezi un fisier .doc in vba. ;)
10Q itlearning

Apostolu
Mesaje: 285
Membru din: Joi Aug 20, 2009 4:05 pm

Re: Rulare macro pe mai multe fisiere

Mesaj de Apostolu » Vin Ian 31, 2014 12:46 pm

Multumesc frumos, dar eu sunt la nivelul vazut cum face un macro wordul si apoi modificat ca sa inlocuiasca alte caractere intre ele. :oops:
Din fericire cand am insirat 20 de astfel de macro unul dupa altul, a functionat de parca era unul singur ! :lol:

alcoool2
Mesaje: 969
Membru din: Mie Dec 15, 2010 4:25 pm

Re: Rulare macro pe mai multe fisiere

Mesaj de alcoool2 » Vin Ian 31, 2014 1:30 pm

Cred ca ar fi bune sa ne dai niste exemple ca sa avem cu ce lucra ;)
10Q itlearning

Apostolu
Mesaje: 285
Membru din: Joi Aug 20, 2009 4:05 pm

Re: Rulare macro pe mai multe fisiere

Mesaj de Apostolu » Dum Feb 02, 2014 10:53 am

Le-am pus in ordinea in care trebuie sa ruleze:
1.

Cod: Selectaţi tot

Sub InlocuiriSpatii()
'
'If something goes wrong, go to the errorhandler
    On Error GoTo ERRORHANDLER
'Checks the document for excessive spaces between words

    With Selection
        .HomeKey Unit:=wdStory
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
             'Here is where it is actually looking for spaces between words
            .Text = " [ ]@([! ])"
             'This line tells it to replace the excessive spaces with one space
            .Replacement.Text = " \1"
            .MatchWildcards = True
            .Wrap = wdFindStop
            .Format = False
            .Forward = True
             'execute the replace
            .Execute Replace:=wdReplaceAll
        End With
         
        With .Find
             'This time its looking for excessive spaces after a paragraph mark
            .Text = "^p "
             'What to replace it with
            .Replacement.Text = "^p"
            .MatchWildcards = False
            .Wrap = wdFindStop
            .Format = False
            .Forward = True
             'Execute the replace
            .Execute Replace:=wdReplaceAll
        End With
    End With
ERRORHANDLER:
    With Selection
        .ExtendMode = False
        .HomeKey Unit:=wdStory
    End With
   
End Sub
2.

Cod: Selectaţi tot

Sub ClearPageBreaks()

On Error GoTo err
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.MatchWildcards = True
.Text = "^12" '^m=^12 (manual break), ^b=^12 (section break)
With .Replacement
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
Exit Sub
err:
MsgBox err.Description, vbOKOnly, "eroare"

End Sub
3.

Cod: Selectaţi tot

Sub Inlocuiri_22_11_2011()
' InlocuiriCaractere Macro
' Macro recorded 20.09.2010 by dsc1

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = Chr(151)
        .Replacement.Text = Chr(45)
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." + Chr(32) + Chr(45) + Chr(238)
        .Replacement.Text = "." + Chr(32) + Chr(45) + Chr(32) + Chr(206)
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." + Chr(13) + Chr(238)
        .Replacement.Text = "." + Chr(13) + Chr(206)
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." + Chr(148) + Chr(13) + Chr(238)
        .Replacement.Text = "." + Chr(148) + Chr(13) + Chr(206)
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
........
End Sub

4.
Ultimul (3) este foarte lung, la limita acceptata de Office 2003 pt. macro.
Si pentru ca am 3 macro din astea mari le activez pe toate cu :

Cod: Selectaţi tot

Sub InlocuiriCaractere()
'
' InlocuiriCaractere 22.11.2011 si 12.01.2012
'
    Call Inlocuiri_22_11_2011
    Call Inlocuiri_12_01_2012
    Call Inlocuiri_16_02_2012

End Sub
La primele 2 macro am primit "imbolduri" de la doctorii de pe ITLearning, alea mari le-am facut singur.
Cred ca se vede diferenta ! :lol:
Ultima oară modificat Lun Feb 03, 2014 9:07 am de către Dr.Windows, modificat 1 dată în total.
Motiv: Adaugare taguri CODE

Apostolu
Mesaje: 285
Membru din: Joi Aug 20, 2009 4:05 pm

Re: Rulare macro pe mai multe fisiere

Mesaj de Apostolu » Mie Mar 05, 2014 3:23 pm

Anybody ????? :))))

Închis

Înapoi la “Visual Basic for Application (VBA) - Intrebari tehnice”