การย่อภาพ

[siamsrising]

พอดีผมยากย่อภาพให้ตามช่องเลยได้ทำ vba ขึ้นครับตอนนี้สามารถย่อภาพตามช่องได้แล้วแต่ภาพนั้นจะลงต่อๆกันมาครับแต่ยากเพิ่มโดยสามารถเลือกช่องเพื่อใส่ภาพเช่นต้องการใส่ภาพช่อง A1 และ C1 แต่ไม่ใส่ช่อง B1 โดยให้เว้นช่อง B1 ไว้

Code: Select all

Private Sub CommandButton1_Click()
Dim PicFormat As String
Dim Rng As Range
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
xColIndex = Application.ActiveCell.Column
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
xRowIndex = xRowIndex + 1
Next
End If
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Dim PicFormat As String
Dim Rng As Range
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
If IsArray(PicList) Then
    For Each Rng In Selection
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lloop), _
            msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        lloop = lloop + 1
    Next
Else
'Other Code
End If

ซึ่งจะรองรับการเลือกเซลล์ที่จะวางข้อมูลเอาไว้ก่อน ไม่เช่นนั้นจะต้องกำหนดตัวแปรว่าจะให้วางในเซลล์ใดบ้างแล้วค่อย Loop เอาภาพไปวางในเซลล์ที่เรากำหนดไว้แทนการเลือกเอาไว้ก่อนครับ

[siamsrising]

ได้แล้วครับขอบคุณมากครับ แต่งงว่าทำไมถึงไม่สามารถคลิ๊กที่ A1 ได้เลยแต่ต้องคลิ๊กช่องอื่นก่อนแล้วค่อยมาคลิ๊กช่อง A1 ถึงวางรูปได้ครับ
เช่นต้องการวางภาพที่ A1 ต้องไปคลิ๊กช่องอื่นก่อนที่ไม่ใช่ A1 ก่อน 1 ครั้งแล้วค่อยกับมาคลิ๊กช่อง A1 ภาพถึงจะขึ้นครับ รบกวนอาจารหน่อยครับ

[logic]

ลองดูครับ

ย้าย lloop ไปไว้บรรทัดบน

Code: Select all

For Each Rng In Selection
    lloop = lloop + 1  
    Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lloop), _
        msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
Next

[siamsrising]

ได้แล้วครับขอบคุณมากครับ