返回列表 上一主題 發帖

vba 如何修改新增公式 可以自動貼下一排

vba 如何修改新增公式 可以自動貼下一排

想要貼滿5個後,換下一排在貼5個....以此類推
請幫幫我!!


公式如下:
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

回復 2# samwang


   

這是我期望中的圖!!
用VBA貼完模組後,在手動修改的!!


希望能5個一排後,直接跳下一排
並且能全部都調整圖片大小!!
貼5個調整大小是因為剛好EXCEL展開後的圖,差不多5個方便查看!!

以上~請求大神幫忙!!

TOP

回復 4# samwang


    原本就有寫沒錯!!不過寫的人離職了,而我部會這個太複雜了QQ

TOP

回復 7# ML089


太棒了!!有各位神人真的幫我很大的忙!!有上百張~上千圖片要貼呢!!
真的非常感謝~

另外想請問如果想加入固定長寬或比例該加在公式哪邊?

TOP

回復 8# samwang


   

太棒了!!
固定A1我剛好也需要 XD!!真是挖到寶了!!非常感謝神人出手幫忙....

另外想請問如果想加入固定長寬或比例該加在公式哪邊?

TOP

回復  ML089


太棒了!!有各位神人真的幫我很大的忙!!有上百張~上千圖片要貼呢!!
真的非常感謝~

另 ...
Muffledsatyr 發表於 2021-4-16 10:46



像這樣的條件...
EXCEL欄寬42 列高170
圖片高度5.79公分 寬度7.72公分有辦法加入嗎?

非常感謝~

TOP

回復  samwang


   

太棒了!!
固定A1我剛好也需要 XD!!真是挖到寶了!!非常感謝神人出手幫忙....
...
Muffledsatyr 發表於 2021-4-16 10:47



    像這樣的條件...
EXCEL欄寬42 列高170
圖片高度5.79公分 寬度7.72公分有辦法加入嗎?

非常感謝~

TOP

回復 14# samwang


   

測試過後EXCEL欄寬有變,可使圖片沒有變...不過還是謝謝你 ^0^

TOP

回復 15# Muffledsatyr


    我有改數值!!感覺那個好像是單位的問題!!
例如公分和像素的問題導致圖片大小的差異....非常感謝!!!

TOP

回復 17# samwang


嗯嗯沒關係我依照你的公式修改了!!
真的方便很多,幾百張圖不需人工一一調整了!!非常感謝~

TOP

        靜思自在 : 成功是優點的發揮,失敗是缺點的累積。
返回列表 上一主題