VBATools

Wyszukanie wartości z pliku Excela i zwrot do Word

by on Sep.20, 2011, under Excel, Porady, Word

Poniższy kod pokazuje jak łatwo odwołać się do pliku Excela z innej aplikacji MS Office. Przytoczona procedura otwiera plik, odwołuje się do arkusza a następnie określa wielkość przeszukiwanych danych w kolumnie A. Zwracany wynik to wartość z kolumny B (analogia do wyszukaj pionowo, jednakże realizowany w pętli). Możemy też realizować działania za pośrednictwem funkcji arkuszowych xlApp.WorksheetFunction, które to będą dostępne podobnie jak realizowane z poziomu arkusza.

Aby nasza procedura była elegancka dla oka, uruchamianie Excela następuje w trybie ukrytym. Testy na kodzie zaleca się jednak wykonywać tak aby arkusz został uwidoczniony oczom programisty, z uwagi na możliwość błędu i zwielokrotnienia aplikacji w osobnych instancjach w trybie ukrytym.

Option Explicit

Private Sub Wyszukaj_z_Excela()
'MVP OShon from VBATools.pl
'dodaj referencje Tools/References/Microsoft Excel x,xx Object Lib.
On Error GoTo blad
Dim xlApp As Excel.Application
Dim xlWKB As Excel.Workbook
Dim xlWKS As Excel.Worksheet
Dim x&, max_row&, szukana$
Set xlApp = New Excel.Application
 xlApp.Visible = False                                     'nie pokazujemy Excela
Set xlWKB = xlApp.Workbooks.Open("C:\Temp\Baza_umowy.xls")   'nazwa pliku
Set xlWKS = xlWKB.Sheets("Tabela umowy")                   'nazwa arkusza
max_row = xlWKS.Cells(xlWKS.Rows.Count, "A").End(xlUp).Row 'ilosc danych w kol A
For x = 1 To max_row
 With xlWKS.Cells(x, 1)                                    'przeszukujemy A
 If .Value = 185 Then                                      'szukamy liczby 185
 szukana = .Offset(, 1).Value                              'zwracamy wartość kol B
 Exit For
 End If
 End With
Next x
 xlApp.Quit                                                'wyłączamy Excela
 MsgBox szukana                                            'zwracamy wynik jako komunikat
 Selection = szukana                                       'wstawienie w miejscu kursora Word

koniec:
On Error Resume Next
 Set xlWKS = Nothing                                       'zwalniamy pamięć
 Set xlWKB = Nothing
 Set xlApp = Nothing
Exit Sub
blad:
 MsgBox "Błąd: " & Err.Number & vbCr & Err.Description, _
 vbExclamation, "VBATools.pl"
Resume koniec
End Sub

Pow. kod umieszczamy w module dokumentu [Alt+F11] Menuinsertmodule, a wywołanie pow. procedury jest realizowane po przez skrót klawiszowy [Alt+F8] lub dzięki wcześniejszemu przypisaniu procedury do przycisku na dokumencie lub z paska szybkiego wybierania.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała