重命名工作表基於INPUT BOX

Question

請幫我改變下面的代碼。需要通過InputBox

由於選擇重命名小區

Sub RenWSs() 

Dim WS As Worksheet 
Dim shtName 
Dim newName As String 
Dim i As Integer 

For Each WS In Worksheets 
    With WS 
     If Trim(.Range("c14")) <> "" Then 
      shtName = Split(Trim(.Range("c14")), " ") 
      newName = shtName(0) 
      On Error GoTo ws_name_error 
      .Name = newName 
      GoTo done 
repeat: 
      .Name = newName & i 
      GoTo done 
ws_name_error: 
      i = i + 1 
      Resume repeat 
     End If 
    End With 
    On Error GoTo 0 
done: 
Next 

End Sub 

Answer 1

有可以使用InputBox幾種方式接入小區C4。

一種是通過在InputBox選擇String，請參見下面的代碼：

Dim RngStr As String 

RngStr = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=2) 
If Trim(.Range(RngStr)) <> "" Then 

---

另一個，是通過在InputBox選擇Range，請參見下面的代碼：

Dim rng As Range 

Set rng = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=8) 
If Trim(rng) <> "" Then 

---

全球代碼

Option Explicit 

Sub RenWSs() 

Dim WS As Worksheet 
Dim shtName 
Dim newName As String 
Dim i As Integer 
Dim RngStr As String 

RngStr = Application.InputBox(prompt:="Select the Range for the new Sheet's name", Type:=2) 
For Each WS In Worksheets 
    With WS   
     If Trim(.Range(RngStr)) <> "" Then 
      shtName = Split(Trim(.Range(RngStr)), " ") 
      newName = shtName(0) 
      On Error GoTo ws_name_error 
      .Name = newName 
      GoTo done 
repeat: 
      .Name = newName & i 
      GoTo done 
ws_name_error: 
      i = i + 1 
      Resume repeat 
     End If 
    End With 
    On Error GoTo 0 
done: 

Next 

End Sub 

---

要了解更多有關InputBox功能：您要使用`InputBox`什麼https://msdn.microsoft.com/en-us/library/office/ff839468.aspx