Wyszukanie wartości z pliku Excela i zwrot do Word

by vbatools 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.