Witaj Gościu! ( Zaloguj | Rejestruj )

Forum PHP.pl

 
Reply to this topicStart new topic
> Export zdjęcia z MSSQL do MS Excel, Export zdjęcia z MSSQL do MS Excel
trafas
post 21.05.2012, 23:01:44
Post #1





Grupa: Zarejestrowani
Postów: 87
Pomógł: 12
Dołączył: 31.05.2006

Ostrzeżenie: (0%)
-----


Witam,

Chciałbym pobrać zdjęcia przechowywane w bazie jako warości bitowe i zapisać je do pliku Excela.

Pośrednio chciałem to zrobić w ten sposób:

1. najpierw z bazy generuję raport z nazwami plików - raport exportuję do Excela
2. wyciągam zdjęcia z bazy i zapisuję je do swojego katalogu
3. W Excelu odpalam makro, które zaczyta mi pliki do arkusza

W zasadzie takie coś już udało mi się zrobić i byłoby wszystko dobrze gdyby nie to, że po odpaleniu makra zdjęcia w rzeczywistości nie są importowane do Excela lecz tylko tworzone są w na arkuszu obiekty typu Picture, które zawierają adresację do zdjęć we wskazanym katalogu.
Jeżeli usunę katalog to pozostają w Excelu niewypełnione obiekty.

Export raportu i Export plików pomijam, natomiast niżej przedstawiam makro, które zaciąga zdjęcia ze wskazanego katalogu do wskazanej kolumny.
Makro pobiera po kolei:
- ścieżkę do katalogu w którym są wcześniej wyexportowane zdjęcia
- ilość wierszy z nazwami plików
- kolumnę w której są nazwy plików
- kolumnę do której będą wpisywane pobrane zdjęcia


  1. Sub test()
  2. Application.ScreenUpdating = False
  3. Dim i AS Integer, p AS Picture, r AS Range, c AS Range, ii AS Integer, DirFile AS String, pPath AS String
  4.  
  5. Dim rowsQty AS Integer, fileNamesCol AS String, imageDestCol AS String, pathToFiles AS String
  6.  
  7. pathToFiles = InputBox("Podaj ścieżkę do plików", "Ścieżka")
  8. rowsQty = InputBox("Podaj ilość wierszy z danymi", "Ilość wierszy")
  9. fileNamesCol = InputBox("Podaj nazwę kolumny z nazwami zdjęć", "Kolumna z nazwami")
  10. imageDestCol = InputBox("Podaj nazwę kolumny gdzie będą zapisywane zdjęcia", "Kolumna docelowa")
  11.  
  12. fileNamesCol = fileNamesCol + "1:" + fileNamesCol + CStr(rowsQty)
  13. pathToFiles = pathToFiles + "\"
  14.  
  15. ii = 0
  16. Set r = ActiveSheet.Range(fileNamesCol)
  17. ActiveSheet.DrawingObjects.Delete
  18. For Each c In r
  19. ii = ii + 1
  20. If c <> "" Then
  21.  
  22. DirFile = c.Value
  23. DirFile = pathToFiles + DirFile
  24.  
  25. With ActiveSheet
  26.  
  27. Set p = .Pictures.Insert(DirFile)
  28. .DrawingObjects(p.Name).Left = .Columns(imageDestCol).Left
  29. .DrawingObjects(p.Name).Top = .Rows(ii).Top
  30. .Rows(ii).RowHeight = p.Height
  31. .DrawingObjects(p.Name).Placement = xlMoveAndSize
  32. .DrawingObjects(p.Name).PrintObject = True
  33.  
  34. End With
  35.  
  36. End If
  37.  
  38. Next c
  39. Application.ScreenUpdating = True
  40. End Sub
Go to the top of the page
+Quote Post

Reply to this topicStart new topic
1 Użytkowników czyta ten temat (1 Gości i 0 Anonimowych użytkowników)
0 Zarejestrowanych:

 



RSS Wersja Lo-Fi Aktualny czas: 28.03.2024 - 23:06