[µo°Ý] ¦b¸ê®Æ§¨¤¤§PÂ_¦³µL¬Û¦PÀɦW¦AÀx¦s

s13030029

§Úªºµ{¦¡¬O­n±N§Úªº¤u§@ªí¶×¥X¦¨µL¥¨¶°ªº¬¡­¶Ã¯
©Ò¥H§Úªºµ{¦¡·|¦Û°Ê«Ø¥ß¤@­Ó¸ê®Æ§¨¡A¦A§â§ÚªºÀɮ׶ץX¦Ü¨º­Ó¸ê®Æ§¨
¦ý¬O§Ú²{¦bªºµ{¦¡¨S¿ìªk§PÂ_¸ê®Æ§¨¸Ì¦³µL­«½ÆªºÀɦW
©Ò¥H§Ú§Æ±æ¯à¥[¤J§PÂ_¦³¬Û¦P¦WºÙ´N¸õ¦^inputbox­«·s¿é¤JÀɦW
¦pªG¨S¦³¬Û¦PÀɦW´Nª½±µÀx¦s
§Æ±æ¯à¦³°ª¤âÀ°¦£~~~~~~~·P¿E¤£ºÉ~~~~~~~~

1. Sub ¶×¥X»sµ{°O¿ýªí()
   
2. 
   
3.     Titlename = ThisWorkbook.Sheets("»sµ{Àˬd°O¿ýªí").Range("H4").Value
   
4.     Dim ylFolder As String
   
5.     ylFolder = ThisWorkbook.Path & "\" & Titlename & "°O¿ýªí" '«ü©w¸ê®Æ§¨
   
6.     If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder
   
7. 
   
8.     Dim xPath As String
   
9.     xPath = Application.ActiveWorkbook.Path
   
10.     Application.ScreenUpdating = False
    
11.     Application.DisplayAlerts = False
    
12.    
    
13.     With ActiveSheet
    
14.        .Copy
    
15.        ActiveSheet.DrawingObjects.Delete
    
16.        X = InputBox("½Ð¿é¤JÀɦW!!", "¥t¦s·sÀÉ", Titlename & " " & "ÀËÅç³ø§i")
    
17.         If X <> "" Then
    
18.             Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
    
19.             FileFormat:=xlExcel8
    
20.             MsgBox "Àx¦s¦¨¥\¡I"
    
21.         ElseIf X = "" Then
    
22.             MsgBox "¤w¨ú®øÀx¦s!!!"
    
23.         End If
    
24.        Application.ErrorCheckingOptions.BackgroundChecking = False
    
25.        Application.ActiveWorkbook.Close False
    
26.     End With
    
27.     Application.DisplayAlerts = True
    
28.     Application.ScreenUpdating = True
    
29.    
    
30. End Sub

½Æ»s¥N½X

§PÂ_­«½ÆÀɦW.rar (28.11 KB)

¤U¸ü¦¸¼Æ: 3

2019-6-18 15:08

kim223824

§A¿é¤JªºÀɦW¥i¦ê¤W¤é´Á+®É¶¡´N¤£·|­«½Æªº°ÝÃD yyyymmddhhmm

kim223824

¦^´_ 1# s13030029

§A¿é¤JªºÀɦW¥i¦ê¤W¤é´Á+®É¶¡´N¤£·|­«½Æªº°ÝÃD yyyymmddhhmm

s13030029

¦^´_ 3# kim223824
¦]¬°§Ú·Q­n¥Ñ¨Ï¥ÎªÌ¦Û­q¦WºÙ¡A©Ò¥H¤~¤£¥[¤é´Á

s13030029

¦^´_ 1# s13030029
¤w¸Ñ¨M~~
´£¨Ñµ{¦¡½Xµ¹¤j®a°Ñ¦Ò

1. Sub ¶×¥X»sµ{°O¿ýªí()
   
2. 
   
3.     Titlename = ThisWorkbook.Sheets("»sµ{Àˬd°O¿ýªí").Range("H4").Value
   
4.     Dim ylFolder As String
   
5.     ylFolder = ThisWorkbook.Path & "\" & Titlename & "°O¿ýªí" '«ü©w¸ê®Æ§¨
   
6.     If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder
   
7.    
   
8.     Dim stFileName As String
   
9.     Dim xPath As String
   
10.     xPath = Application.ActiveWorkbook.Path
    
11.     Application.ScreenUpdating = False
    
12.     Application.DisplayAlerts = False
    
13.    
    
14.     With ActiveSheet
    
15.        .Copy
    
16.        ActiveSheet.DrawingObjects.Delete
    
17. XX:
    
18.        X = InputBox("½Ð¿é¤JÀɦW!!", "¥t¦s·sÀÉ", Titlename & " " & "ÀËÅç³ø§i")
    
19.        stFileName = ylFolder & "\" & X & ".xls"
    
20.        If X <> "" Then
    
21.             If Dir(stFileName) <> "" Then
    
22.                 MsgBox "¤w¦³¬Û¦PÀɦW¡I"
    
23.                 GoTo XX
    
24.             Else
    
25.                 Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
    
26.                 FileFormat:=xlExcel8
    
27.                 MsgBox "Àx¦s¦¨¥\!"
    
28.             End If
    
29.         ElseIf X = "" Then
    
30.             MsgBox "¤w¨ú®øÀx¦s!!!"
    
31.         End If
    
32.        Application.ErrorCheckingOptions.BackgroundChecking = False
    
33.        Application.ActiveWorkbook.Close False
    
34.     End With
    
35.     Application.DisplayAlerts = True
    
36.     Application.ScreenUpdating = True
    
37.    
    
38. End Sub

½Æ»s¥N½X

°Ñ¦Ò¸ê®Æ¡Ghttps://analysistabs.com/excel-vba/check-file-exists-location-folder/