VBATools

Dodanie obrazka do kom贸rki obok

by on May.19, 2011, under Excel, Porady

Chcesz osadzi膰 grafik臋 w kom贸rce?

Za艂o偶eniami jest, aby grafika by艂a z wymiarowana dok艂adnie jak cela obok. Procedura zadzia艂a dla zaznaczonego obszaru kom贸rek, kt贸ry b臋dzie zawiera艂 nazw臋 plik贸w dla ka偶dej z celi z osobna. Zdj臋cia b臋d膮 pobierane z jednego katalogu.

Option Explicit
'MVP OShon from VBATools.pl
Sub Wstaw_fote_do_celi_obok()
Dim Filename$, place As Range, myPic As Object, kom$
For Each place In Selection
 DoEvents
 kom = place.Offset(, 1).Address
 Filename = "c:\Temp\" & place 'lub inna sciezka
 If FileExists(Filename) = True Then
  Set myPic = ActiveSheet.Pictures.Insert(Filename)
  With myPic
  .Top = Range(kom).Top
  .Left = Range(kom).Left
  .ShapeRange.LockAspectRatio = msoFalse
  .ShapeRange.Height = Range(kom).RowHeight
  .ShapeRange.Width = Range(kom).Width
   If .ShapeRange.Type <> msoPicture Then
    .Cut
    Range(kom).PasteSpecial Paste:=xlPasteValues
   End If
  End With
 End If
Next
Set myPic = Nothing
End Sub
Public Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
 FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function

Efekt mo偶na przedstawi膰 nast臋puj膮co:

XL_Foto_in_Cell

Rys. 1 Przed i po zastosowaniu kodu

W przypadku braku rozszerzenia w nazwach kom贸rek mo偶emy poda膰 go w zmiennej:

If FileExists(Filename & ".jpg") = True Then
 Set myPic = ActiveSheet.Pictures.Insert(Filename & ".jpg")

Jeszcze jednym pomys艂em do wykorzystania jest kompresja obrazk贸w, jednak偶e dost臋p do tej opcji mo偶na uzyska膰 poprzez automatyzacj臋:

Dim Kompresja As CommandBarControl
Set Kompresja = Application.CommandBars.FindControl(ID:=6382)
 Application.SendKeys "%e~"
 Application.SendKeys "%a~"
 Kompresja.Execute
Set Kompresja = Nothing

Procedura przygotowana i testowana w 2007

(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.

:, , , ,

3 Comments for this entry

  • natallliii

    Wszystko spoko ale zacina si臋 w przypadku wi臋kszej ilo艣ci zdj臋膰 馃槓

  • Kasia

    Dzi臋ki za kod, bardzo mi si臋 przyda艂, czy jest jednak mo偶liwo艣膰 zmiany rozdzielczo艣ci zdj臋cia, np. aby najpierw zmniejszy艂 zdj臋cie o 30%, a potem dopasowa艂 do wielko艣ci kom贸rki?

    • Profile photo of vbatools
      vbatools

      Nie ma w tym kodzie nic, coby powodowa艂o zacinanie. Niemniej jednak rozdzielczo艣膰 zdj臋cia w procesie importu jest kluczowa. Je艣li jej pojemno艣膰 jest zbyt wysoka to sam office mo偶e odm贸wi膰 jej importu. Wi臋cej mo偶liwo艣ci daje ten dodatek http://vbatools.pl/zdjecia-do-komorek-arkusza/ cho膰 zmiana rozdzielno艣ci/wielko艣ci pliku nie jest procesem 艂atwym i szybkim, jaki oczekuje si臋 od narz臋dzi napisanych w VBA.

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
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