sâmbătă, 13 octombrie 2018


   Am vrut sa dezvolt la un moment dat o aplicatie de completare automata a campurilor din mai multe fisiere word de tip sablon, si aveam nevoie ca datele din fisierul excel cu care lucram sa se populeze automat prin vlookup dintr-o arhiva care functiona ca baza de date pe server, si era in format excel (bine era salvata ca notepad fiind de dimensiuni foarte mari, pentru a se deschide mai usor).
     Eu am avut nevoie sa deschid in mod automat acea baza de date, sa o modific (Valorile unor lucrari in acel fisier erau trecute cu virgula si nu cu punct asa cum aveam eu setat in modul meu de lucru. Problema e ca n-aveam voie sa modific intreg fisierul, pentru ca erau persoane care il foloseau asa ca atare, fiind pe server, iar solutia trebuia implementata pentru tot biroul).

Cod:
Sub Import_db()
Dim fisier_db As Workbook
Dim fisier_lucru As Workbook
Application.DisplayAlerts = False 'Nu vrem sa ne afiseze cum completeaza fiecare informatie in casute, vrem doar rezultatul final al importului
Set fisier_db = Workbooks.Open("\\server_G\folder\baza_de_date.xlsx") 'Deschide fisierul de pe server (mai exact baza de date)
Set fisier_lucru = ThisWorkbook 'definim fisierul in care vrem sa fie importate datele ca fisier de baza
fisier_db.Sheets("Sheet1").Range("A:X").Copy 'Copiaza din fisierul cu date, informatiile pe care vrem sa le importam
Worksheets("Sheet1").Columns("Q").Replace _
What:=",", Replacement:=".", _
SearchOrder:=xlByColumns, MatchCase:=True 'Modifica datele asa cum v-am povestit, cu functia replace inlocuim virgula cu punct.
fisier_lucru.Sheets("Centralizator").Range("A1").PasteSpecial 'Inseram datele in fisierul destinatie
fisier_db.Close 'inchidem fisierul cu date de import
End Sub


PS: Poti face acest modul sa ruleze atunci cand deschizi fisierul de lucru, pentru ca evident vrei sa ai baza de date actualizata atunci cand lucrezi:
Mergi pe ThisWorkbook in meniul de dezvoltare (Developer) si inserezi:

Private Sub Workbook_Open()
   Application.Run "'Fisier_lucru.xlsb'!Import_db" 'numele_fisierului_de_lucru!numele_modulului_macro

End Sub

Pentru ajutor, intrebari sau colaborari ma puteti contacta in privat sau in comentarii :-)

0 comentarii:

Trimiteți un comentariu