ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

§Úªºµ{¦¡¬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.     Titlename = ThisWorkbook.Sheets("»sµ{Àˬd°O¿ýªí").Range("H4").Value
  3.     Dim ylFolder As String
  4.     ylFolder = ThisWorkbook.Path & "\" & Titlename & "°O¿ýªí" '«ü©w¸ê®Æ§¨
  5.     If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder

  6.     Dim xPath As String
  7.     xPath = Application.ActiveWorkbook.Path
  8.     Application.ScreenUpdating = False
  9.     Application.DisplayAlerts = False
  10.    
  11.     With ActiveSheet
  12.        .Copy
  13.        ActiveSheet.DrawingObjects.Delete
  14.        X = InputBox("½Ð¿é¤JÀɦW!!", "¥t¦s·sÀÉ", Titlename & " " & "ÀËÅç³ø§i")
  15.         If X <> "" Then
  16.             Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
  17.             FileFormat:=xlExcel8
  18.             MsgBox "Àx¦s¦¨¥\¡I"
  19.         ElseIf X = "" Then
  20.             MsgBox "¤w¨ú®øÀx¦s!!!"
  21.         End If
  22.        Application.ErrorCheckingOptions.BackgroundChecking = False
  23.        Application.ActiveWorkbook.Close False
  24.     End With
  25.     Application.DisplayAlerts = True
  26.     Application.ScreenUpdating = True
  27.    
  28. End Sub
½Æ»s¥N½X
§PÂ_­«½ÆÀɦW.rar (28.11 KB)

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

TOP

¦^´_ 1# s13030029

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

TOP

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

TOP

¦^´_ 1# s13030029
¤w¸Ñ¨M~~
´£¨Ñµ{¦¡½Xµ¹¤j®a°Ñ¦Ò
  1. Sub ¶×¥X»sµ{°O¿ýªí()

  2.     Titlename = ThisWorkbook.Sheets("»sµ{Àˬd°O¿ýªí").Range("H4").Value
  3.     Dim ylFolder As String
  4.     ylFolder = ThisWorkbook.Path & "\" & Titlename & "°O¿ýªí" '«ü©w¸ê®Æ§¨
  5.     If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder
  6.    
  7.     Dim stFileName As String
  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. XX:
  17.        X = InputBox("½Ð¿é¤JÀɦW!!", "¥t¦s·sÀÉ", Titlename & " " & "ÀËÅç³ø§i")
  18.        stFileName = ylFolder & "\" & X & ".xls"
  19.        If X <> "" Then
  20.             If Dir(stFileName) <> "" Then
  21.                 MsgBox "¤w¦³¬Û¦PÀɦW¡I"
  22.                 GoTo XX
  23.             Else
  24.                 Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
  25.                 FileFormat:=xlExcel8
  26.                 MsgBox "Àx¦s¦¨¥\!"
  27.             End If
  28.         ElseIf X = "" Then
  29.             MsgBox "¤w¨ú®øÀx¦s!!!"
  30.         End If
  31.        Application.ErrorCheckingOptions.BackgroundChecking = False
  32.        Application.ActiveWorkbook.Close False
  33.     End With
  34.     Application.DisplayAlerts = True
  35.     Application.ScreenUpdating = True
  36.    
  37. End Sub
½Æ»s¥N½X
°Ñ¦Ò¸ê®Æ¡Ghttps://analysistabs.com/excel-vba/check-file-exists-location-folder/

TOP

        ÀR«ä¦Û¦b : ¤@¥y·Å·xªº¸Ü¡A´N¹³©¹§O¤H¨­¤WÅx­»¤ô¡A¦Û¤v·|ªg¨ì¨â¤Tºw¡C
ªð¦^¦Cªí ¤W¤@¥DÃD