Sari la conținut

Import imagini in Excel – Macro


Hai sa presupunem ca ai nevoie sa adaugi 200 de imagini in Excel pe care neaparat sa le redimensionezi sa fie exact cat o celula. Sper ca ti-ai dat seama deja ca e o munca repetitiva si de migala care poate sa iti manance multe ore. Partea buna e ca ai o alternativa, pe care o descriu intr-un video.

Import imagini Excel macro

Excel si pozele

Excel nu e o unealta facuta pentru lucrul cu imagini. Poti adauga imagini, poti sa le modifici putin, dar, dupa cum stim cu totii, Excel e mai bun la alte lucruri.

Fac o paranteza, ar fi fain daca ar fi cateva macro-uri pentru:

  • Repararea masinii fara costuri
  • Evitarea statului la coada
  • Fluidizarea traficului

Sunt insa cazuri in care trebuie musai sa ai si o poza cu produsul in tabelul in care lucrezi. Pentru aceste cazuri am facut acest video.

Video

Da, la acest video ma refeream.

Nu ma supar daca imi lasi un like daca ti s-a parut util. In acest fel va ajunge la mai multe persoane pe YouTube.

Cod VBA

In video vorbeam despre un cod VBA, aici il poti gasi:

Sub InsertPictures()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
For lLoop = LBound(PicList) To UBound(PicList)
Set Rng = Cells(xRowIndex, xColIndex)
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
xRowIndex = xRowIndex + 1
Next
End If
End Sub

Download

Aici poti descarca un exemplu care are codul inclus si un buton pentru rularea acelui cod.

Alte abordari

Stii alte feluri prin care putem importa mai multe imagini in Excel, te rog lauda-te in zona de comentarii.


.

2 comentarii la „Import imagini in Excel – Macro”

    1. Am gasit solutia pentru introducerea pozelor pe orizontala: am schimbat partea xRowIndex = xRowIndex + 1 in xColIndex = xColIndex + 1, mai jos se gaseste intreaga varianta modificata:

      Sub InsertPictures()

      Dim PicList() As Variant

      Dim PicFormat As String

      Dim Rng As Range

      Dim sShape As Shape

      On Error Resume Next

      PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)

      xColIndex = Application.ActiveCell.Column

      If IsArray(PicList) Then

      xRowIndex = Application.ActiveCell.Row

      For lLoop = LBound(PicList) To UBound(PicList)

      Set Rng = Cells(xRowIndex, xColIndex)

      Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left,
      Rng.Top, Rng.Width, Rng.Height)

      xColIndex = xColIndex + 1

      Next

      End If

      End Sub

      Pentru restul trebuie sa mai ma gandesc si daca itnre timp nu am gasit astept raspunsul oricaruia care stie. Multumesc

Lasă un răspuns

Adresa ta de email nu va fi publicată. Câmpurile obligatorii sunt marcate cu *