Jumat, 29 September 2023

Upload Foto ke cell pada excel berikut dengan Nama File Foto tersebut

 


NSN ALONE CHANEL-Menyisipkan gambar di lembar kerja Anda adalah cara yang mudah untuk memperlihatkan informasi atau menambahkan minat visual, Menyisipkan gambar tidak jelas menggunakan pencarian Bing tidak didukung di Excel untuk web. Gambar dapat dianggap tidak jelas karena salah satu alasan berikut:
  1. Situs web yang menghosting gambar tidak menggunakan HTTPS. Hal ini dapat dianggap sebagai kerentanan keamanan yang potensial.
  2. URL situs web gambar bukanlah alamat yang valid.
Jika ingin menggunakan proses insert gambar pada MS. Excel secara otomatis  menyesuaikan dengan panjang dan lebar cell yang dibentuk,dan dilakukan secara masa dan dalam jumlah picture yang banyak, maka bisa lihat tutorialnya berikut ini :

Download sample projectnya disini dan disini

Coding Macronya adalah :

Sub inputgambar()

Dim listgambar As Variant, formatgambar As String, rng As Range, sShape As Shape

On Error Resume Next

listgambar = Application.GetOpenFilename(formatgambar, MultiSelect:=True)

xColIndex = Application.ActiveCell.Column

If IsArray(listgambar) Then

    xRowIndex = Application.ActiveCell.Row

    For iLoop = LBound(listgambar) To UBound(listgambar)

    Set rng = Cells(xRowIndex, xColIndex)

    Set sShape = ActiveSheet.Shapes.AddPicture(listgambar(iLoop), msoFalse, msoTrue, rng.Left, rng.Top, rng.Width, rng.Height)

    sShape.Select

    Selection.ShapeRange.ScaleWidth 0.9090916513, msoFalse, msoScaleFromTopLeft

    Selection.ShapeRange.ScaleHeight 0.920001167, msoFalse, msoScaleFromTopLeft

    Selection.Placement = xlMoveAndSize

    sShape.Top = rng.Top + (rng.Height / 2) - (sShape.Height / 2)

    sShape.Left = rng.Left + (rng.Width / 2) - (sShape.Width / 2)

    xRowIndex = xRowIndex + 1

   Next

End If

End Sub

Jika ingin menggunakan proses insert gambar pada MS. Excel secara otomatis  menyesuaikan dengan panjang dan lebar cell yang dibentuk,dan dilakukan secara masa dan dalam jumlah picture yang banyak, sekaligus memunculkan penamaan pada cell yang terdapat di bawahnya, maka bisa lihat tutorialnya berikut ini :

Download sample projectnya disini

Coding tambahannya ada disini

Option Explicit

Sub TampilkanNamaFile()

Dim Folder As String

Dim x As Long: x = 3

Folder = Dir("D:\Images\" & "*JPG")

Do While Len(Folder) > 0

Sheet2.Range("B" & x) = Folder

x = x + 2

Folder = Dir

Loop

End Sub

Terimakasih telah berkunjung di blog ini, semoga apa yang disampaiakn dalam potingan ini sedikit bermanfaat, jika berkenan silahkan tinggalkan komentarnya. Terimakasih



Siti Maryam Fatonah

Author & Editor

2 comments:

nuansazuhdi mengatakan...

Alhamdulillah working mas tutornya buat input gambar masal, versi hapus gambarnya udah ada lum yah..? mau script VBA nya dunk mas.

Anonim mengatakan...

Sub HapusFotoMassal()
Dim shp As Shape
Dim ws As Worksheet

' Mengatur lembar kerja aktif
Set ws = ActiveSheet

' Menghapus semua bentuk (gambar) di lembar kerja
For Each shp In ws.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

MsgBox "Semua foto telah dihapus!"
End Sub

NIH CODENYA