Gửi bởi
tuantu315
Thực sự em đang rất cần sự giúp đỡ . Xin các bro giúp đỡ .
Bạn sửa lại code cũ một chút là được
Mã nguồn PHP:
Sub test() Dim imgFilter As String, fileName As Variant, imgH As Double, imgW As Double, posX As Double, posY As Double Dim cellH As Double, cellW As Double, gap As Double, ws As Worksheet, i As Integer, j As Integer Dim Pic As Shape Set ws = ActiveSheet On Error Resume Next cellH = ws.[O5] cellW = ws.[O6] ws.Columns.ColumnWidth = cellW ws.Rows.RowHeight = cellH imgH = cellH * ws.[O1] posX = ws.Cells(1, ws.[O3]).Left posY = ws.Cells(ws.[O2], 1).Top gap = cellH * ws.[O4] imgFilter = "Image Files(*.jpg),*.jpg," & "Image Files(*.png),*.png," & "Image Files(*.jpeg),*.jpeg," & "Image Files(*.bmp),*.bmp" fileName = Application.GetOpenFilename(FileFilter:=imgFilter, FilterIndex:=1, Title:="Chon anh", MultiSelect:=True) If Not IsArray(fileName) Then Exit Sub Sheet2.Range("A17:D17").Resize(100).ClearContents For j = 1 To 100 For Each Pic In ActiveSheet.Shapes If Pic.Top = posY + (j - 1) * (imgH + gap) Then Pic.Delete End If Next Next For i = LBound(fileName) To UBound(fileName) With ws.Pictures.Insert(fileName(i)) With .ShapeRange .LockAspectRatio = msoTrue .Height = imgH End With .Left = posX .Top = posY + (i - 1) * (imgH + gap) Sheet2.Range("A16").Offset(i).Value = Sheet2.TextBox1.Value Sheet2.Range("B16").Offset(i).Value = Sheet2.TextBox2.Value Sheet2.Range("C16").Offset(i).Value = Dir(fileName(i)) End With Next iEnd Sub
View more random threads: