| |
あー・・送信してから気が付いた・・。逆に拡張子なしのファイルに"限定"するなら
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim x As Long
Dim Ph As String, NewN As String
Const MyF As String = "C:\a\" '←末尾に\を入れること
On Error Resume Next
If Intersect(Target, Range("A:A").SpecialCells(2, 2)) _
Is Nothing Then Exit Sub
If Err.Number <> 0 Then Exit Sub: Cancel = True
With Target
If Mid$(StrReverse(.Value), 4, 1) = "." Then Exit Sub
x = InStrRev(.Value, "\")
If x = 0 Then Exit Sub
Ph = Left$(.Value, x)
End With
NewN = InputBox("変更するファイル名を" & _
" 拡張子なしで入力して下さい")
If NewN = "" Then Exit Sub
Name MyF & Target.Value As MyF & Ph & NewN
Target.Value = Ph & NewN
End Sub
と、変更して下さい。
|
|
Kein
- 06/3/2(木) 20:15 -
