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