สร้าง Userform แล้วบันทึกลง 2 sheet พร้อมกัน

[toncenter]

เรียนอาจารย์ทุกท่านครับ
ผมต้องการนำข้อมูลที่ใส่ใน Userform บันทึกลง 2 Sheetพร้อมกัน(ตามไฟล์แนบ)
-Sheet(DATA) ให้ลงมาเป็น List เรียงลงมาตามข้อมูลที่เพิ่ม
-Sheet(DATA1) ให้บันที่ค่าแค่บรรทัดเดียว (เมื่อป้อนข้อมูลใหม่จะทับที่เดิม)
ผมลองทำครั้งแรกครับดูตามยูทูป ต้องแก้ไขหรือต้องใช้สูตรไหนรบกวนชี่แนะด้วยครับ

New1.xlsm

[snasui]

ช่วยลำดับขั้นตอนการทำงานมาให้ด้วยว่า คลิกปุ่มไหน กรอกค่าที่ Object ใดบ้าง กรอกครบแล้วคลิกปุ่มไหน หากถูกต้องจะแสดงผลอย่างไร จะได้สะดวกในการทดสอบครับ

[toncenter]

เมื่อกรอกข้อมูลในtextboxต่างๆแล้ว กดปุ่ม "เพิ่มข้อมูล" (CommandButton1)
ค่าต่างๆต้องการให้เข้าที่ 2 Sheet ดังนี้
-Sheet(DATA) ให้ลงมาเป็น List เรียงลงมาตามข้อมูลที่เพิ่ม
-Sheet(DATA1) ให้บันที่ค่าแค่บรรทัดเดียว (เมื่อป้อนข้อมูลใหม่จะทับที่เดิม)ค่าที่ได้ใน Sheet(DATA1) ให้แสดงใน Sheet(PDF)
แต่จริงๆแล้วถ้าเป็นไปได้ให้เข้าที่ Sheet(PDF) โดยตรงไม่ต้องมีSheet(DATA1)ก็ได้ครับ
ส่วนปุ่ม "PDF" (CommandButton3)คือทดลองทำให้มันแยกบันทึกก็ทำไม่ได้ครับ
*ผมอาจจะอธิบายผิดๆถูกๆเพราะไม่เคยทำมาก่อนเลยครับ

[snasui]

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

Code: Select all

Private Sub CommandButton1_Click()
    With Sheets("DATA")
        Do
            r = r + 1
        Loop Until Cells(r, 2) = ""
        Cells(r, 2) = T1.Text
        Cells(r, 3) = T2.Text
        
        If M.Value = True Then
            Cells(r, 4) = "Male"
        End If
        If W.Value = True Then
            Cells(r, 4) = "Female"
        End If
        
        Cells(r, 5) = T3.Text
        Cells(r, 6) = T4.Text
        Cells(r, 7) = CB1.Text
        Cells(r, 8) = Zipcode.Text
        Cells(r, 9) = Sel1.Text
        Cells(r, 10) = CB2.Text
        Cells(r, 11) = CB3.Text
        Cells(r, 12) = CB7.Text
        Cells(r, 13) = T5.Text
        Cells(r, 14) = Sel2.Text
        Cells(r, 15) = CB5.Text
        Cells(r, 16) = CB6.Text
        Cells(r, 17) = T7.Text
        Cells(r, 18) = T6.Text
        Cells(r, 19) = CB8.Text
        Cells(r, 20) = PAY.Text
    End With
    With Worksheets("DATA1")
        Cells(2, 5) = T3.Text
        Cells(2, 6) = T4.Text
        Cells(2, 7) = CB1.Text
        Cells(2, 8) = Zipcode.Text
        Cells(2, 9) = Sel1.Text
        Cells(2, 10) = CB2.Text
        Cells(2, 11) = CB3.Text
        Cells(2, 12) = CB7.Text
        Cells(2, 13) = T5.Text
        Cells(2, 14) = Sel2.Text
        Cells(2, 15) = CB5.Text
        Cells(2, 16) = CB6.Text
        Cells(2, 17) = T7.Text
        Cells(2, 18) = T6.Text
        Cells(2, 19) = CB8.Text
        Cells(2, 20) = PAY.Text
    End With
    T1.Text = ""
    T2.Text = ""
    
    M.Value = False
    W.Value = False
    
    T3.Text = ""
    T4.Text = ""
    CB1.Text = ""
    Zipcode.Text = ""
    Sel1.Text = ""
    CB2.Text = ""
    CB3.Text = ""
    CB7.Text = ""
    T5.Text = ""
    Sel2.Text = ""
    CB5.Text = ""
    CB6.Text = ""
    T7.Text = ""
    T6.Text = ""
    CB8.Text = ""
    PAY.Text = ""
End Sub

[toncenter]

ได้ทำการทดสอบ code ที่อาจารย์แนะนำแล้วครับ ผลคือข้อมูลวิ่งเข้าเพียง Sheet เดียวเหมือนเดิมครับ
เข้าเฉพาะSheetที่เปิดไว้ก่อน Run userform ครับ

[snasui]

ลืมเพิ่มจุดครับ

ปรับ Code เป็นด้านล่างครับ

Code: Select all

'Other code
With Worksheets("DATA1")
        .Cells(2, 5) = T3.Text
        .Cells(2, 6) = T4.Text
        .Cells(2, 7) = CB1.Text
        .Cells(2, 8) = Zipcode.Text
        .Cells(2, 9) = Sel1.Text
        .Cells(2, 10) = CB2.Text
        .Cells(2, 11) = CB3.Text
        .Cells(2, 12) = CB7.Text
        .Cells(2, 13) = T5.Text
        .Cells(2, 14) = Sel2.Text
        .Cells(2, 15) = CB5.Text
        .Cells(2, 16) = CB6.Text
        .Cells(2, 17) = T7.Text
        .Cells(2, 18) = T6.Text
        .Cells(2, 19) = CB8.Text
        .Cells(2, 20) = PAY.Text
End With]
'Other code

[toncenter]

ได้แล้วครับขอบคุณอาจารย์มากครับ
ต่อเนื่องเลยนะครับคือผมต้องการ SAVE เป็นไฟล์ PDF
แต่ต้องการระบุเลยว่า เป็น sheet ที่ชื่อว่า "PDF" แล้วนำค่าในเซล B6 และ B8มาตั้งชื่อไฟล์ครับ

อันนี้คือที่ผมนำมาใช้ครับต้องแก้ตรงไหนครับ

Private Sub CommandButton3_Click()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\User\Desktop\PDF\" & Format(Now, "yyyymmddhmmss") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _True
End Sub

[toncenter]

ตอนนี้ได้ลองแก้ไปนิดหน่อยครับ
1.ได้ไฟล์ .PDF ที่ออกมาจากSheet(PDF)ตามต้องการ แต่ยังติดตรงอยากให้ออกแค่ page 1หน้าเดียวครับ
2.ได้ชื่อไฟล์ ในเซล "B6" ตามต้องการ แต่ยังติดตรง จะต่อชื่อไฟล์ตามด้วยเซล "B8"
อธิบายเซล คือ B6=ชื่อลูกค้า , B8=เบอร์โทร
ประมาณว่าชื่อไฟล์PDFคือ "สมชาย 0987654321.pdf"
ผมต้องแก้ตรงไหนครับ

Code: Select all

Private Sub CommandButton3_Click()

Worksheets("PDF").Activate

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & Range("B6").Value & ".pdf", Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
     True
         
End Sub

[snasui]

กรุณาแนบไฟล์ที่ได้ Update Code ล่าสุดมาด้วยจะได้ตอบต่อไปจากนั้นครับ

[toncenter]

กรุณาแนบไฟล์ที่ได้ Update Code ล่าสุดมาด้วยจะได้ตอบต่อไปจากนั้นครับ

[snasui]

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

Code: Select all

Private Sub CommandButton3_Click()

    Worksheets("PDF").Activate
    ActiveSheet.OLEObjects("CommandButton1").PrintObject = False
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$I$52"
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & Range("B6").Value & " " _
        & Range("b8").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, _
        OpenAfterPublish:=True

        Cells(6, 2) = ""
'Other code

[toncenter]

ขอบคุณมากๆเลยครับอาจารย์
ถ้าผมต้องการนำเซลไหนมาเพิ่มที่ชื่อไฟล์ก็เพิ่ม code แบบนี้เข้าไปใช่มั้ยครับ
คือมันต้องเรียงแบบนี้หรอครับ ผมลองใส่แบบนี้ไปใช้ได้ครับ

Code: Select all

 " _
        & Range("เซล").Value & "

[snasui]

ต้องการเชื่อมอะไรเข้าไปก็ย่อมได้ครับ เครื่องหมายสำหรับการเชื่อมคือ & ส่วนเครื่องหมายวรรคตามด้วย _ หมายถึง Code บรรทัดล่างเป็น Code ที่ติดกันกับบรรทัดบน เราใช้เครื่องหมายนี้ในการตัด Code ยาว ๆ ออกเป็นหลายบรรทัดเพื่อให้ง่ายต่อการอ่านครับ

[toncenter]

ใกล้สำเร็จแล้วครับติดอยู่ตรงผมต้องการให้โชว์รูปที่ sheet(PDF)
แต่มันต้องกดรันทุกครั้งเลยอ่ะครับ
ตอนนี้ผมวางไว้ที่module1ไว้ก่อนครับ
คือต้องการให้โชว์รูปเลยตอนที่มีค่าเข้าไปที่"B18" ของ sheet(PDF)ครับ
ผมควรเอาcodeไปไว้ตรงไหนครับ

Code: Select all

Sub ShowPicture()
Dim r As String
Dim imgIcon As Object
Dim Obj As Object
For Each Obj In ActiveSheet.Shapes
If Left(Obj.Name, 4) = "Pict" Then
    Obj.Delete
End If
Next Obj
r = Range("B18").Text
With Range("F16")
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="C:\Users\Mold\Desktop\PDF\111\" & r & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=216, Height:=186)
End With
Set imgIcon = Nothing
End Sub

อันนี้ลิ้งค์ไฟล์ที่ผมลองทำครับ
https://drive.google.com/open?id=1MYCdg ... TUMvnRGxxG

[snasui]

ควรจะเอา Code ล่าสุดแนบมาในไฟล์แล้วแนบมาในฟอรัมนี้ก่อน จะได้สะดวกในการตอบ ไม่ควรแนบไฟล์เป็น Link มาจากแหล่งอื่น อ่านกฎการใช้บอร์ดทุกข้อด้านบนด้วยครับ

สำหรับคำว่า "อ่ะครับ" ให้ใช้คำว่า "ครับ" แทน ตามกฎข้อ 1 ครับ

[toncenter]

ต้องขออภัยอาจารย์ด้วยครับที่ผมไม่รอบคอบกับกฎระเบียบก่อนตั้งคำถามครับ
-ส่วนของ code ผมได้แนบไปกับไฟล์ด้วยครับอยู่ที่module1
-สวนการแนบไฟล์เป็น Link มาจากแหล่งอื่นนั้นคือผมเพิ่งทำไฟล์นี้เป็นไฟล์แรกเลยครับไม่มีความรู้เรื่องvbaมาก่อนเลย ดูจากบอร์ดและยูทูป ก๊อปปี้แล้วมาแก้ไขครับ เข้าใจบ้างไม่เข้าใจบ้างครับ
-ไฟล์มีขนาดใหญ่เกินไปครับอัพโหลดไม่ได้ ผมต้องทำไฟล์ใหม่ใช่มั้ยครับ

[snasui]

ไฟล์มีขนาดใหญ่เกินไปครับอัพโหลดไม่ได้ ผมต้องทำไฟล์ใหม่ใช่มั้ยครับ

สร้างไฟล์ใหม่หรือตัดไฟล์เก่าให้เหลือเฉพาะส่วนที่เป็นปัญหาแล้วค่อยแนบมาถามกันครับ

[toncenter]

ตอนนี้ดึงรูปเข้าได้แล้วครับ
-แต่เมื่อกดปุ่ม "SAVE PDF" (CommandButton3) ทำไมไฟล์ PDF ออกมา2หน้าอีกแล้วครับทั้งที่ code

Code: Select all

Set imgIcon = Nothing
    ActiveSheet.OLEObjects("CommandButton1").PrintObject = False
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$I$52"
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

ตัวนี้ก็ยังอยู่โดยหน้าที่2เป็นแค่หน้าว่าง
-ส่วนcodeที่ให้ลบรูปออกก่อนนำรูปใหม่เข้านั้นก็ใช้ได้ครับ แต่อยากเพิ่มให้ลบอีกครั้งหลัง SAVE เป็น PDF แล้วต้องแก้ตรงไหนครับ

[toncenter]

ไฟล์รูปครับ

[snasui]

ปรับอย่าให้รูปล้นเซลล์ครับ

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

Code: Select all

With Range("F16:I28")
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="C:\Users\Mold\Desktop\PDF\111\" & k & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=.Width - 5, Height:=.Height)
End With