Snasui Excel Forum

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

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

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

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

Code: Select all

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

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

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

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