Snasui Excel Forum

Code: Select all

Application.DisplayAlerts = False

Code: Select all

 Application.DisplayAlerts = False

Code: Select all

Private Sub Workbook_Open()
Workbooks.Open Filename:="C:\Test.xlsm", Password:="", ReadOnly:=True
End Sub

Code: Select all

Private Sub Workbook_Open()
Workbooks.Open Filename:="C:\Test.xlsm", Password:="", ReadOnly:=True
End Sub

Code: Select all

Public Sub MacroSaveAs_Filename()
''''''''''''''''''''''''''
    Dim i, jcount As Integer
    i = 6
    jcount = 0
    Do While Sheet1.Cells(i, 1).Value <> ""
        i = i + 1
        jcount = jcount + 1
    Loop
    Sheet1.Cells(2, 4) = jcount
''''''''''''''''''''''''''''''''''''
    'SAVE ชื่อ และ ตั้งชื่อ Folder ตาม Excel
    Dim xlsName, folderName, path, Co_name, in_charge As String
    path = Application.ActiveWorkbook.path
'    xlsName = Sheets("Sheet1").Range("B6")
    xlsName = Sheet1.Cells(i - 1, 2).Text
'    folderName = Sheets("Sheet1").Range("B6")
    folderName = Sheet1.Cells(i - 1, 2).Text
'    Co_name = Sheets("Sheet1").Range("C6")
    Co_name = Sheet1.Cells(i - 1, 3).Text
    in_charge = Sheet1.Cells(i - 1, 4).Text
    MkDir path & "\" & folderName                                                               'สร้าง Folder ชื่อ folderName ใน path
    
    Workbooks.Open Filename:=path & "\EX_book.xlsm"
    
'    Application.Run "path & " \ " & folderName & " \ " & xlsName & .xlsm!Sheet1.test", pathf = path
'    Application.Run "path & " \ " & folderName & " \ " & xlsName & .xlsm!Sheet1.test", folder = folderName
    ActiveWorkbook.Sheets("Log").Range("A1").Value = Co_name
    ActiveWorkbook.Sheets("Log").Range("N19").Value = in_charge
    ActiveWorkbook.SaveAs Filename:=path & "\" & folderName & "\" & xlsName & ".xlsm", FileFormat:=52
    ActiveWorkbook.Close
    Call Shell("explorer.exe" & " " & path & "\" & folderName, vbNormalFocus)
    
    Workbooks.Open Filename:=path & "\First_Form.xlsm"
    ActiveWorkbook.SaveAs Filename:=path & "\" & folderName & "\" & xlsName & " First Form.xlsm", FileFormat:=52
    MsgBox "Please print this form and bring it to your first time audit"
End Sub

Code: Select all

Private Sub Workbook_Open()
Workbooks.Open Filename:="D:\EERS\EX_book.xlsm", Password:="", ReadOnly:=True
End Sub

Code: Select all

Private Sub Workbook_Open()
Workbooks.Open Filename:="D:\EERS\EX_book.xlsm", Password:="", ReadOnly:=True
End Sub

Code: Select all

'Other code
Workbooks.Open Filename:=pth & "\First_Form.xlsm"
If Dir(pth & "\" & folderName & "\" & xlsName & " First Form.xlsm") <> "" Then
    MsgBox "This file existing, Can't save with the same name.", vbInformation
    Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=pth & "\" & folderName & "\" & xlsName & " First Form.xlsm", FileFormat:=52
MsgBox "Please print this form and bring it to your first time audit"
'Other code