Generare lista - proces verbal

Informatii despre cum se utilizeaza Microsoft Word 2007. Editare, formatare, automatizare de documente
Închis
ccirtina
Mesaje: 280
Membru din: Lun Oct 11, 2010 9:49 pm
Localitate: Craiova

Generare lista - proces verbal

Mesaj de ccirtina » Mar Ian 31, 2012 7:33 pm

word 2007
La fiecare sfarsit de an se trage linie si toate mapele de rezolutii ce au fost prelucrate de-a lungul anului trebuie trimise catre Arhiva Nationala, dar nu asa simplu cum am crezut initial ci insotite de un Proces Verbal in care sunt mentionate cateva elemente din fiecare rezolutie listata si apoi semnata de cel care preda si cel care primeste.
Trebuie sa intrat in fiecare document si cautate 4 elemente pe care sa le pun intr-un tabel si asa mai departe cu celelalte 138 000 de documente.
Ideea sta asa:
Toate documentele se gasesc intr-un fisier bine stabilit de exemplu D:\Rezolutii\2011\

Trebuie generat un nou document in care sa se insereze
1. titlul : Proces -Verbal de predare rezolutii
2. un tabel cu 5 coloane si atatea linii cate exista documente(rezolutii)
Capul tabelului trebuie sa se regaseasca pe fiecare pagina scrisa si trebuie sa contina:
2.1. Nr.Crt;Nr.Dosar;Rezolutia Nr.;Nr.RC;CUI
elementele ce trebuie extrase din aceste rezolutii sunt constante

Aceste elemente sunt extrase dintr-o rezolutie(ce este boldat este variabil)

NUMĂR DE ORDINE ÎN REGISTRUL COMERȚULUI: J16/1905/2004
COD UNIC DE ÎNREGISTRARE: 16862053
DOSAR NR. 1058/2011
REZOLUȚIA NR. 881/28.01.2011

Daca un element nu este gasit sa lase celula libera si sa treaca la gasirea urmatorului.

Ordonarea sa fie dupa dorinte(alfabetic sau dupa nr.dosar sau rezolutie nr. sau Nr.RC sau CUI)
La sfarsitul listei sa se insereze "am predat am primit"
Va multumesc

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

Re: Generare lista - proces verbal

Mesaj de Dr.Windows » Vin Feb 17, 2012 7:22 pm

In "teorie" nu ar fi greu... doar trebuie deschis pe rand fiecare document si cautate acele "elemente" pe care le-ai enumerat... si se "extrage textul pana la urmatorul spatiu, dar problema apare in schimb daca nu se respecta niste reguli stricte, de ex. la DOSAR NR. 1058/2011 daca se completeaza DOSAR NR. 1058[spatiu]/[spatiu]2011.

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

Re: Generare lista - proces verbal

Mesaj de ccirtina » Vin Feb 17, 2012 7:51 pm

Apar fara variatii de scriere.
Este standard, pentru ca acele fisiere au fost generate tot cu comenzi VBA.
Si apoi este foarte important ca exemplu, pentru ca se pleaca de aici si se pot face tot felul de combinatii.
Multumesc

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

Re: Generare lista - proces verbal

Mesaj de ccirtina » Joi Feb 23, 2012 6:40 pm

Salutari.
Am gasit pe un site codul de mai jos.
In aceasta faza nu face altceva decat sa de-a mesaje cu fisierele existente in foldere si subfoldere.

Cod: Selectaţi tot

Option Explicit

Sub Get_All_SubDirectories()

Dim arSubDir() As String
Dim sSubDir As String
Dim i1 As Integer

sSubDir = GetSubDir("C:\Users\Costi\Desktop\bpirezerva\citatii\")

If LenB(sSubDir) <> 0 Then
arSubDir = Split(sSubDir, ";")
For i1 = 0 To UBound(arSubDir)
MsgBox arSubDir(i1)
'Debug.Print arSubDir(i1)
Next i1
End If

End Sub


Function GetSubDir(ByVal sPath As String, Optional ByVal sPattern As Variant) As Variant

Dim sDir As String
Dim sDirLocationForText As String

On Error GoTo Err_Clk

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

If IsMissing(sPattern) Then
sDir = Dir$(sPath, vbDirectory)
Else
sDir = Dir$(sPath & sPattern, vbDirectory)
End If


Do Until LenB(sDir) = 0

' -----------------------------------------------------
' This will be the location for the sub directory
' -----------------------------------------------------
If sDir <> "." And sDir <> ".." Then
sDirLocationForText = sDirLocationForText & ";" & sPath & sDir
End If
sDir = Dir$

Loop

If Left$(sDirLocationForText, 1) = ";" Then sDirLocationForText = Right(sDirLocationForText, Len(sDirLocationForText) - 1)
GetSubDir = sDirLocationForText

Err_Clk:
If err <> 0 Then
err.Clear
Resume Next
End If
End Function
Cum fac acum sa-mi deschida un document Blank pe care sa-l salveze cu numele lista1(asta ar fi usor)
(partea mai dificila acum urmeaza) - in acest fisier sa-mi deschida fiecare document gasit si sa faca punctul 2.
Va multumesc

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

Re: Generare lista - proces verbal

Mesaj de Dr.Windows » Lun Feb 27, 2012 3:17 pm

Uite o idee de cautare in text dupa "DOSAR NR." pe care mai departe poti sa o generalizezi si la celelalte elemente de cautat:

Cod: Selectaţi tot

Sub GetWord()
    Dim oRange As Range
    Dim sSentence As String
    
    Set oRange = ActiveDocument.Range
    With oRange.Find
        .Text = "DOSAR NR."
        .Execute
        
        If .Found Then
            oRange.Expand Unit:=wdParagraph
            'oRange.MoveStart Unit:=wdWord, Count:=2
            'oRange.MoveEnd Unit:=wdWord, Count:=2
            sSentence = oRange.Text
            Debug.Print sSentence ' ex. de afisare in fereastra Immediate: DOSAR NR. 1058/2011
        Else
            sSentence = "?"
        End If
    End With
End Sub
Ideea este ca vei cauta un "text" dupa care te poti juca cu obiectul de tip "range" in asa fel incat dupa ce a gasit textul cautat poti "expanda" elementul gasit la intregul paragraf (Unit:=wdParagraph) si astfel obtii intregul "paragraf" adica linia "DOSAR NR. 1058/2011" pe care o poti "prelucra suplimentar" sa extragi separat numarul dosarului de an daca iti trebuie separat.

In exemplul de mai sus mai ai o varianta - cele 2 linii comentate in care te poti "juca" cu mutarea marcatorilor START/AND peste un numar de cuvinte in asa fel in cat poti extrage direct numarul dosarului si/sau anul separat.

Evident, din lipsa timpului, pentru usurinta exemplificarii am ales ca totul sa se "intample" in documentul activ (Set oRange = ActiveDocument.Range) dar tu poti modifica sa preia documentul word "deschis" tot cu VBA si apoi sa faci cautarile in acel document.

Si evident pentru partea de Diacritice in macrouri stii deja cum se procedeaza tot din subiectul tau pe aceasta tema... ;)

Pentru mai multe detalii despre obiectul RANGE si ce metode si "unit-uri" poti folosi vezi in link-ul de pe MSDN.

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

Re: Generare lista - proces verbal

Mesaj de ccirtina » Lun Feb 27, 2012 8:44 pm

Pana sa pun in aplicare sfaturile date de Dr.Windows doresc mai intai sa pot genera o lista de fisiere ce sunt preluate din toate subfolderele unui folder.
Spre exemplificare:
Am un folder general: C:\Users\Costi\Desktop\Lucru
in acest folder exista 2 sau mai multe foldere care la randul lor contin alte subfoldere etc pana cand ultimul subfolder contine fisiere
Dar sa nu uitam ca si in celelalte subfoldere pot exista fisiere.
Codul de mai jos imi cauta foarte restrans.
Adica ultimul folder contine de exemplu 5 subfoldere care la randul lor contin fisiere.
Practic cauta intr-un folder si in subfolderele primare
dar eu vreau sa caut direct in C:\Users\Costi\Desktop\Lucru si sa-mi scoata lista pana nu mai gaseste sublodere si fisiere.
I aceasta faza sunt extrase doar numele(restul aprofundam abia dupa ce voi reusi sa extrag toata lista)

Cod: Selectaţi tot

Option Explicit
Dim arSubDir() As String
Dim sSubDir As String
Dim i1 As Integer
Dim FolderFiles() As String ' declares a dynamic array variable
Dim tmp As String, fCount As Integer
Dim sDir As String
Dim sDirLocationForText As String

Sub Get_All_SubDirectories()

sSubDir = GetSubDir("C:\Users\Costi\Desktop\Lucru\2012\februarie\12022012\")

If LenB(sSubDir) <> 0 Then
arSubDir = Split(sSubDir, ";")
For i1 = 0 To UBound(arSubDir)
Debug.Print arSubDir(i1)

    fCount = 0
   tmp = Dir(arSubDir(i1) & "\*.*")
    While tmp <> Empty
        fCount = fCount + 1
        ReDim Preserve FolderFiles(1 To fCount)
        ' declares the array variable again (size+1)
        FolderFiles(fCount) = tmp
        tmp = Dir
        Debug.Print FolderFiles(fCount)
    Wend
    
    MsgBox fCount & " filenames are found in the folder " & arSubDir(i1)
    Erase FolderFiles ' deletes the varible contents, free some memory
Next i1
End If

End Sub

Function GetSubDir(ByVal sPath As String, Optional ByVal sPattern As Variant) As Variant


On Error GoTo Err_Clk

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

If IsMissing(sPattern) Then
sDir = Dir$(sPath, vbDirectory)
Else
sDir = Dir$(sPath & sPattern, vbDirectory)
End If
Do Until LenB(sDir) = 0

' -----------------------------------------------------
' This will be the location for the sub directory
' -----------------------------------------------------
If sDir <> "." And sDir <> ".." Then
sDirLocationForText = sDirLocationForText & ";" & sPath & sDir
End If
sDir = Dir$

Loop

If Left$(sDirLocationForText, 1) = ";" Then sDirLocationForText = Right(sDirLocationForText, Len(sDirLocationForText) - 1)
GetSubDir = sDirLocationForText

Err_Clk:
If err <> 0 Then
err.Clear
Resume Next
End If
End Function
Cum fac sa sape mai adanc in folder?

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

Re: Generare lista - proces verbal

Mesaj de Dr.Windows » Lun Feb 27, 2012 9:35 pm

Daca foloseai Office 2003 exista o varianta "mai scurta": Application.Filesearch dar chiar si fara 2003 vezi ca in acel subiect s-au mai discutat cateva variante si poate una din ele iti este de folos.

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

Re: Generare lista - proces verbal

Mesaj de ccirtina » Lun Feb 27, 2012 11:38 pm

Am reusit sa gasesc cum se creeaza o lista cu toate fisierele indiferent cate subfoldere exista.

Cod: Selectaţi tot

Option Explicit

Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames

' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Users\Costi\Desktop\Lucru", "*.*", True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
Debug.Print FileNameWithPath ' & Chr(13)
'MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath

' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If

End Sub
Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
DirFile = Dir 'next file
Loop

' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next

End Sub
Preluat de aici: http://excel2007tips.blogspot.com/2007/ ... -2007.html
Functioneaza in word2007 garantat.
EEEEEEEEEEEE, acum sa vedem cum implementam ceea ce a spus Dr.Windows

Închis

Înapoi la “Intrebari despre Word 2007”