Generare lista - proces verbal
Generare lista - proces verbal
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
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
-
- Moderator
- Mesaje: 4570
- Membru din: Vin Iul 31, 2009 7:32 am
Re: Generare lista - proces verbal
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.
Re: Generare lista - proces verbal
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
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
Re: Generare lista - proces verbal
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.
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
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
(partea mai dificila acum urmeaza) - in acest fisier sa-mi deschida fiecare document gasit si sa faca punctul 2.
Va multumesc
-
- Moderator
- Mesaje: 4570
- Membru din: Vin Iul 31, 2009 7:32 am
Re: Generare lista - proces verbal
Uite o idee de cautare in text dupa "DOSAR NR." pe care mai departe poti sa o generalizezi si la celelalte elemente de cautat:
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.
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
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.
Re: Generare lista - proces verbal
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)
Cum fac sa sape mai adanc in 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
-
- Moderator
- Mesaje: 4570
- Membru din: Vin Iul 31, 2009 7:32 am
Re: Generare lista - proces verbal
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.
Re: Generare lista - proces verbal
Am reusit sa gasesc cum se creeaza o lista cu toate fisierele indiferent cate subfoldere exista.
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
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
Functioneaza in word2007 garantat.
EEEEEEEEEEEE, acum sa vedem cum implementam ceea ce a spus Dr.Windows