Snasui Excel Forum

Code: Select all

Private Sub Export()
Dim FileSaveName As String
Dim ri As Range
With Workbooks("DumP.xlsm").Worksheets("Report")
    Set ri = .Range(.Range("A1"), .Range("J65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
ri.Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
FileSaveName = Application.GetSaveAsFilename( _
    filefilter:="Excel Files (*.xlsx),*.xlsx")
If FileSaveName <> "" Then
    ActiveWorkbook.SaveAs Filename:=FileSaveName, FileFormat:=xlNormal
    MsgBox "Already save file " & FileSaveName
End If
Application.DisplayAlerts = False
ActiveWindow.Close
Workbooks("DumP.xlsm").Worksheets("Report").Activate
Application.DisplayAlerts = True
End Sub

Code: Select all

FileSaveName = Application.GetSaveAsFilename( _
filefilter:="Excel Workbook (*.xlsx),*.xlsx")

Code: Select all

FileSaveName = "C:\Desktop\Report.xlsx"

Code: Select all

Private Sub CommandButton1_Click()
Dim MyWorkbook As Workbook
Dim FileSaveName As String
Dim MyFile As String
Dim ri As Range
MyFile = "Report.xlsx"
For Each MyWorkbook In Application.Workbooks
If MyWorkbook.Name = MyFile Then
MyWorkbook.Activate
End If
Next
Kill (MyFile)
With Workbooks("DumP.xlsm").Worksheets("Report")
    Set ri = .Range(.Range("A1"), .Range("J65536") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
End With
ri.Copy
Workbooks.Add
     ActiveSheet.Paste
Application.CutCopyMode = False
On Error Resume Next
FileSaveName = "Report.xlsx"
 Workbooks("Report.xlsx").Saved = True
    ActiveWorkbook.SaveAs Filename:="Report.xlsx"
            Application.DisplayAlerts = False
ActiveWindow.Close
Workbooks("DumP.xlsm").Worksheets("Report").Activate
Application.DisplayAlerts = True
If Err > 0 Then
MsgBox "ไม่มีการส่งออกข้อมูล "
Exit Sub
Else
MsgBox "การส่งออกข้อมูลสมบูรณ์" & FileSaveName
End If
    End Sub

Code: Select all

MyFile = "Report.xlsx"
For Each MyWorkbook In Application.Workbooks
If MyWorkbook.Name = MyFile Then
MyWorkbook.Activate
End If
Next
Kill (MyFile) 'Debug

Code: Select all

FileSaveName = Application.GetSaveAsFilename(, filefilter:="Exel Files (*.xlsx),*.xlsx", Title:=" DumP โปรดระบุชื่อไฟล์และที่ตั้งเพื่อบันทึก")
    If FileSaveName = "False" Then
    MsgBox "ยกเลิกการส่งออกข้อมูล", vbOKOnly, "DumP"
    Application.DisplayAlerts = False
ActiveWindow.Close
Workbooks("DumP.xlsm").Worksheets("Report").Activate
Application.DisplayAlerts = True
    Exit Sub

Code: Select all

Private Sub Mail()
Dim lng As Long, rs As Range, rt As Range
Dim Inx As Long, ry As Range, ro As Range
If Label17.Caption <> "FileC" Then
Exit Sub
End If
 Application.ScreenUpdating = False
On Error Resume Next
  i = InputBox(Message, "กำหนดลำดับเริ่มต้นที่ท่านต้องการ", Default, 11500, 7000)
Total = InputBox(Message, "กำหนดลำดับสุดท้าย", Default, 11500, 7000)
For i = i To [Total]
    [Choice] = i
    Sheet15.Range("A1").Value = Sheet18.Range("AB5").Value
  With Worksheets("FileA")
On Error Resume Next
    lng = Application.Match(Sheet15.Range("A1"), .Range("A:A"), 0)
    Set rs = .Range("A" & lng).Resize(, 21)
    Set rt = Sheet15.Range("A3")
    End With
    rs.Copy: rt.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    Rep.Rep
    Sheet20.Range("D5").Value = Sheet15.Range("G29").Value
    Sheet20.Range("D7").Value = Sheet15.Range("G30").Value
    Sheet20.Range("D9").Value = Sheet15.Range("G31").Value
    Sheet20.Range("D11").Value = Sheet15.Range("G32").Value
    Sheet20.Range("D13").Value = Sheet15.Range("G33").Value
    If [Choice] = 0 Then
    Exit Sub
    Else
    Sheet20.PrintOut
End If
 Next i
  
End Sub

Code: Select all

 i = InputBox(Message, "กำหนดลำดับเริ่มต้นที่ท่านต้องการ", Default, 11500, 7000)
Total = InputBox(Message, "กำหนดลำดับสุดท้าย", Default, 11500, 7000)

Code: Select all

Worksheets("Sheet1").Range("Choice")

Code: Select all

Set r = Worksheets("Sheet1").Range("Choice")

Code: Select all

Private Sub CommandButton26_Click()
frmlonex.Show
End Sub

Code: Select all

Private Sub CommandButton26_Click()
frmlone.Hide
frmlonex.Show
End Sub

Code: Select all

Private Sub UserForm_Terminate()
frmlone.Show
End Sub

Code: Select all

frmlone.Hide

Code: Select all

frmlone.Hide

Code: Select all

Private Sub UserForm_Terminate()
frmlone.Show
End Sub