| |
ネットを参考にして勉強中です。
日程表作ります。
ボタンを押して新規ファイルを作成するときに、
同じ名前のファイルを作成しないようにしたいのです。
ボタンを押すと、’ブック名取得’の"ActiveWorkBookName"が反転して
題名のようなメッセージが出ます。
変数の型は Stringになっているのですが、どのように訂正したら良いのでしょうか。 ご教授願います。
Public Sub MakeNitteiBook()
Dim makefile As String
Dim BookName As String
'作成するファイル名
makefile = GetSaveFileName
If makefile = "" Then
Exit Sub
End If
'ブック名を取得
BookName = GetFileName(makefile)
BookName = GetFileNameOnly(BookName)
If UCase(GetFileNameOnly(ActiveWorkbookName)) = UCase(BookName) Then
Beep
MsgBox "このブックと同じブック名は作成することはできません。", , "日程表作成"
Exit Sub
End If
'新規にブックを作成
NewBookMake makefile
Workbooks(BookName).Activate
End Sub
'作成するファイル名(名前を付けて保存)
Public Function GetSaveFileName() As String
Dim sfile As String
sfile = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="エクセルファイル(*.xls),*.xls", Title:="保存するエクセルファイルの指定")
If sfile = "False" Then
GetSaveFileName = ""
Else
GetSaveFileName = sfile
End If
End Function
'新規にブックを作成
Public Sub NewBookMake(filename As String)
Dim tFile As Workbook
Set tFile = Workbooks.Add
'上書きメッセージを表示させない(Trueの時、警告やメッセージを表示します）
Application.DisplayAlerts = False
tFile.Saved = True
tFile.SaveAs filename:=filename
'tFile.Close
Application.DisplayAlerts = True
End Sub
'フルパスからファイル名のみ取得
Function GetFileName(fullpath As String) As String
Dim i As Integer
Dim nlen As Integer
Dim s As String
On Error GoTo ErrSub
nlen = Len(fullpath)
For i = nlen To 0 Step -1
s = Mid$(fullpath, i, 1)
If s = "\" Then Exit For
Next
s = Right$(fullpath, nlen - i)
GetFileName = s
Exit Function
ErrSub:
GetFileName = ""
End Function
'ファイル名から拡張子を除く
Function GetFileNameOnly(sfina As String) As String
Dim i As Integer
Dim nlen As Integer
Dim s1 As String
Dim s2 As String
On Error GoTo ErrSub
s2 = ""
For i = 1 To Len(sfina)
s1 = Mid$(sfina, i, 1)
If s1 <> "." Then
s2 = s2 + s1
Else
Exit For
End If
Next
GetFileNameOnly = s2
Exit Function
ErrSub:
GetFileNameOnly = ""
End Function
|
|
かつこ
- 09/11/18(水) 21:40 -
