vba ¦p¦ó­×§ï·s¼W¤½¦¡ ¥i¥H¦Û°Ê¶K¤U¤@±Æ

Muffledsatyr

·Q­n¶Kº¡5­Ó«á¡A´«¤U¤@±Æ¦b¶K5­Ó....¥H¦¹Ãþ±À
½ÐÀ°À°§Ú!!


¤½¦¡¦p¤U:
Sub InsertPictures()
'Update 20140513
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

samwang

¦^´_ 1# Muffledsatyr


«á¾Ç©È»~·|·N«ä¡A½Ð°Ý¥i¥H¤W¶Ç½d¨Ò¶Ü? ³o¼Ë¤ñ¸û®e©ö¤F¸Ñ¡A·PÁ¡C

Muffledsatyr

¦^´_ 2# samwang


   

¤U¸ü (184.19 KB)

2021-4-14 10:01

³o¬O§Ú´Á±æ¤¤ªº¹Ï!!
¥ÎVBA¶K§¹¼Ò²Õ«á¡A¦b¤â°Ê­×§ïªº!!


§Æ±æ¯à5­Ó¤@±Æ«á¡Aª½±µ¸õ¤U¤@±Æ
¨Ã¥B¯à¥þ³¡³£½Õ¾ã¹Ï¤ù¤j¤p!!
¶K5­Ó½Õ¾ã¤j¤p¬O¦]¬°­è¦nEXCEL®i¶}«áªº¹Ï¡A®t¤£¦h5­Ó¤è«K¬d¬Ý!!

¥H¤W~½Ð¨D¤j¯«À°¦£!!

samwang

¦^´_ 3# Muffledsatyr

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
¥t¥~¡A¦³ÂI¤£¸Ñ´N¬O§A¤£¬O­ì¨Ó´N¦³¼gµ{¦¡¤F¶Ü?


Sub InsertPictures()
'Update 20140513
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)
        If xColIndex > 5 Then xRowIndex = xRowIndex + 1: xColIndex = 1
        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

Muffledsatyr

¦^´_ 4# samwang


    ­ì¥»´N¦³¼g¨S¿ù!!¤£¹L¼gªº¤HÂ÷¾¤F¡A¦Ó§Ú³¡·|³o­Ó¤Ó½ÆÂø¤FQQ

ML089

Sub InsertPictures_5()

Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape, n
On Error Resume Next
'ActiveSheet.Pictures.Delete '§R°£¥þ³¡¹Ï¤ù
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
Set Rng = Application.ActiveCell
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To UBound(PicList)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        n = n + 1
        If n = 5 Then
            n = 0
            Set Rng = Rng.Offset(1, -4)
        Else
            Set Rng = Rng.Offset(0, 1)
        End If
    Next
End If
End Sub

ML089

'¶Kº¡5­Ó«á¡A´«¤U¤@±Æ¦b¶K5­Ó....¥H¦¹Ãþ±À
'ª`·N! °õ¦æµ{¦¡«e¥ý¿ï©w¶K¹Ï°õ¦æ¦ì¸m
Sub InsertPictures_5()

Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape, n, Pages
On Error Resume Next
'ActiveSheet.Pictures.Delete '§R°£¥þ³¡¹Ï¤ù
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
Set Rng = Application.ActiveCell
Pages = 5 '±±¨îÅܼơG¶Kº¡5­Ó«á¡A´«¤U¤@±Æ¦b¶K5­Ó
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To UBound(PicList)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        n = n + 1
        If n = Pages Then 'º¡5®æ«á
            n = 0
            Set Rng = Rng.Offset(1, 1 - Pages) '¸õ¤U¤@¦C¡A°h¦^­ì°_ÂI
        Else
            Set Rng = Rng.Offset(0, 1)
        End If
    Next
End If
End Sub

samwang

¦^´_ 5# Muffledsatyr

©T©w±qA1 ¶}©l±Æ¦C¡A½Ð¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub tt()
Dim PicList, PicFormat$, Rng As Range, sShape As Shape, i&, X%, Y%
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
X = 1 '±qA1¶}©l
If IsArray(PicList) Then
    For i = 1 To UBound(PicList)
        Y = Y + 1
        If Y > 5 Then X = X + 1: Y = 1   '5±i-->´«¤U¤@¦C
        Set Rng = Cells(X, Y)  '¶K¤W·Ó¤ùªº¦ì¸m
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(i), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
    Next
End If
End Sub

Muffledsatyr

¦^´_ 7# ML089


¤Ó´Î¤F!!¦³¦U¦ì¯«¤H¯uªºÀ°§Ú«Ü¤jªº¦£!!¦³¤W¦Ê±i~¤W¤d¹Ï¤ù­n¶K©O!!
¯uªº«D±`·PÁÂ~

¥t¥~·Q½Ð°Ý¦pªG·Q¥[¤J©T©wªø¼e©Î¤ñ¨Ò¸Ó¥[¦b¤½¦¡­þÃä?

Muffledsatyr

¦^´_ 8# samwang


   

¤Ó´Î¤F!!
©T©wA1§Ú­è¦n¤]»Ý­n XD!!¯u¬O«õ¨ìÄ_¤F!!«D±`·PÁ¯«¤H¥X¤âÀ°¦£....

¥t¥~·Q½Ð°Ý¦pªG·Q¥[¤J©T©wªø¼e©Î¤ñ¨Ò¸Ó¥[¦b¤½¦¡­þÃä?