Snasui Excel Forum

Code: Select all

Sub Button17_Sort2()
Dim stword1 As String
Dim stword2 As String
Dim stword3 As String
Dim stword4 As String
Dim stword5 As String
Dim stword6 As String
stword3 = Mid(Range("A1"), 7, 50)
stword = "รายงานต่อใบอนุญาต สาขา"
stword4 = "นายหน้า ประกันวินาศภัย"
stword5 = "ประเภทใบอนุญาต"
Range("B5") = stword & " " & stword3 & " " & stword5 & " " & stword4
Range("E3").Select
ActiveSheet.ListObjects("Table4").TableStyle = "TableStyleLight18"
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=13, Criteria1:= _
        "=นายหน้า", Operator:=xlOr, Criteria2:="=โบรคเกอร์"
                    ActiveWorkbook.Worksheets("Sort").ListObjects("Table4").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sort").ListObjects("Table4").Sort.SortFields.Add _
        Key:=Range("Table4[ครั้งที่]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Sort").ListObjects("Table4").Sort.SortFields.Add _
        Key:=Range("Table4[วันหมดอายุ]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sort").ListObjects("Table4").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        Range("SortTable").Select
    Selection.Rows.AutoFit
    Columns("B:I").Columns.AutoFit
    Columns("J:K").ColumnWidth = 13.88
    Columns("L:L").EntireColumn.Hidden = True
     Columns("M:M").Columns.AutoFit
     Columns("N:N").ColumnWidth = 11
End Sub

Code: Select all

Sub Button28_PDF()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim codebranch As String
Dim branchname As String
Dim lictype As String
On Error GoTo errHandler


lictype = Mid(Range("B5"), 48, 7)
codebranch = Left(Range("A1"), 3)
branchname = Mid(Range("A1"), 7, 50)
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd_mm_yy")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Code: Select all

'...Other code
Range("E3").Select
ActiveSheet.ListObjects("Table4").TableStyle = "TableStyleLight18"
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=13, Criteria1:= _
    "=นายหน้า", Operator:=xlOr, Criteria2:="=โบรคเกอร์"
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=6, Criteria1:= _
    "<>ไม่มีรหัส"
'...Other code
    

Code: Select all

Other
Dim codebranch As String 'ประกาศตัวแปร 
Dim branchname As String
Dim lictype As String
On Error GoTo errHandler


lictype = Mid(Range("B5"), 48, 7) 'ตรงส่วนที่เก็บค่าตัวแปรจาก Cell = B5 ผมไม่เข้าใจคำสั่ง Cell.Find Text ก็เลยใช้ MID ดึงค่าจาก B5 มาตัด
codebranch = Left(Range("A1"), 3)
branchname = Mid(Range("A1"), 7, 50)
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd_mm_yy")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
Other

Code: Select all

'...Other code
On Error GoTo errHandler

If InStr(Range("b5").value, "นายหน้า") > 0 Then
    lictype = "นายหน้า"
ElseIf InStr(Range("b5").value, "ตัวแทน") > 0 Then
    lictype = "ตัวแทน"
ElseIf InStr(Range("b5").value, "ร่วมใบอนุญาต") > 0 Then
    lictype = "ร่วมใบอนุญาต"
End If
'lictype = VBA.Mid(Range("B5"), 48, 7)
'...Other code