Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3203 / 13644 ツリー ←次へ | 前へ→

【63579】By Ref 引数の型が一致しません かつこ 09/11/18(水) 21:40 質問[未読]
【63581】Re:By Ref 引数の型が一致しません Hirofumi 09/11/18(水) 22:12 回答[未読]
【63582】Re:By Ref 引数の型が一致しません Hirofumi 09/11/18(水) 22:14 発言[未読]
【63591】Re:By Ref 引数の型が一致しません yoshi 09/11/19(木) 17:37 回答[未読]
【63594】By Ref 引数の型が一致しません かつこ 09/11/19(木) 21:47 お礼[未読]

【63579】By Ref 引数の型が一致しません
質問  かつこ  - 09/11/18(水) 21:40 -

引用なし
パスワード
   ネットを参考にして勉強中です。

日程表作ります。
ボタンを押して新規ファイルを作成するときに、
同じ名前のファイルを作成しないようにしたいのです。

ボタンを押すと、’ブック名取得’の"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

【63581】Re:By Ref 引数の型が一致しません
回答  Hirofumi  - 09/11/18(水) 22:12 -

引用なし
パスワード
   >ボタンを押すと、 'ブック名取得’の"ActiveWorkBookName"が反転して
>題名のようなメッセージが出ます。
>
>変数の型は Stringになっているのですが、どのように訂正したら良いのでしょうか。 ご教授願います。

唐突に、"ActiveWorkBookName"が出て来ているので
"ActiveWorkBookName"は暗黙の型宣言としてVariant型の変数としてコンパイラが見ています
また、此れを引数に与えている、「Function GetFileNameOnly(sfina As String) As String」は、
引数としてString型を要求していませので、「By Ref 引数の型が一致しません」と成っています

【63582】Re:By Ref 引数の型が一致しません
発言  Hirofumi  - 09/11/18(水) 22:14 -

引用なし
パスワード
   尚、モジュール先頭に「Option Explicit」を付ける事をお勧めします

【63591】Re:By Ref 引数の型が一致しません
回答  yoshi  - 09/11/19(木) 17:37 -

引用なし
パスワード
   >ボタンを押すと、’ブック名取得’の"ActiveWorkBookName"が反転して
>題名のようなメッセージが出ます。
ActiveWorkbookName

ActiveWorkbook.Name
の間違いでしょう。

示されたコード(関数)ですが冗長すぎるので少し効率よくかかれると良いとおもいます。
InStrRev関数を使った例

'フルパスからファイル名のみ取得
Function GetFileName(fullpath As String) As String
 GetFileName = Mid(fullpath, InStrRev(fullpath, "\") + 1)
End Function

'ファイル名から拡張子を除く
Function GetFileNameOnly(sfina As String) As String
 If InStr(sfina, ".") Then
  GetFileNameOnly = Left(sfina, InStrRev(sfina, ".") - 1)
 Else
  GetFileNameOnly = sfina
 End If
End Function

作成するファイル名を取得するところも
わざわざ別関数にしなくとも以下で良いとおもいます。

 '作成するファイル名
 makefile = Application.GetSaveAsFilename("", "エクセルファイル(*.xls),*.xls", , "保存するエクセルファイルの指定")
 If makefile = "False" Then Exit Sub

【63594】By Ref 引数の型が一致しません
お礼  かつこ  - 09/11/19(木) 21:47 -

引用なし
パスワード
   yoshiさん、hirofumiさん ありがとうございました。

yoshiさんのコードを使わせていただきました。
すっきりしたコードになりました。

今後もよろしくお願いします。

3203 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free