dポイントプレゼントキャンペーン実施中!

下記コードは「特定のシート(あいうえお、とします。)をコピーして、新しいブックを作り一定の範囲(A1:I38、とします)を値貼り付けし、一部(J:N、とします。)非表示にして任意の名前(L17に名前が出るようにしてありそれを引用してます)を付けて指定の場所(フェイクの為、適当。)へ保存する」という内容のものです。

Sub 保存()
Sheets("あいうえお").Copy
Range("A1:I38").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:N").Select
Selection.EntireColumn.Hidden = True
Dim fname As string

fname = Application.GetSaveAsFilename(InitialFileName:="C\:~~~" & Range("L17").Value)

If fname <> "false" Then
ActiveWorkbook.SaveAs Filename:=fname
End If

End Sub

ある時から、「型が一致しません」といったエラーが出るようになってしまいました。
何かをしたという記憶もありませんし、原因が思い当りません。。
自分で調べてみたのですが、どうにもわからなかったのでどうにかお力添えください…

ここに書いたもの以外で必要な情報があれば、できる限り出しますので教えてください。
宜しくお願い致します。

A 回答 (6件)

マクロを本格的に書く時は、Select をなくせと言います。


今の段階では、はっきりどこが間違いかというと、以下の部分だけです。
File名が、String 型なら、
>If fname <> "false" Then
この部分は間違っています。"False" です。
文字列をそのまま比較すると、binary 比較になってしまうからです。
StrComp 関数などもありますが、ややこしいので、戻り値のままに扱うか、
もしくは、以下のように Vartype 関数を利用します。

それ以上は、任意の部分に関しては、.Range("L17").Value が確実に代入できているか調べるぐらいしかありません。

'これで試してみていただけますか?
'パスの所は適当に変えてください。

Sub 保存2()
Dim fName As Variant
Dim buf As String
Dim wb As Workbook
Dim myPath As String
 '必要に応じて書き換えてください。
 myPath = ThisWorkbook.Path & "\" '末尾には必ず¥を入れてください。
 Worksheets("あいうえお").Copy
 
 Set wb = ActiveWorkbook
 With ActiveSheet
 .Range("A1:I38").Value = .Range("A1:I38").Value '値コピー
 .Columns("J:N").EntireColumn.Hidden = True
  buf = .Range("L17").Value
  If Trim(buf) = "" Then
   MsgBox "ファイル名がありません。", vbCritical
   Exit Sub
  End If
    fName = Application.GetSaveAsFilename( _
    InitialFileName:=myPath & buf, _
    FileFilter:="Excel Files(xlsx(*.xlsx),xlsm(*.xlsm)", _
    Title:="ファイル保存")
  If VarType(fName) = vbBoolean Then
  wb.Close False
  Exit Sub
  End If
 End With
  wb.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbook
  wb.Close False
End Sub
    • good
    • 0

エラーが出るシートでは(多分)



Sub test1()
  Debug.Print "C\:~~~" & Range("L17").Value
End Sub

これでもエラーが出るでしょうね。
あるいは↓でも。

Sub test2()
  MsgBox Range("L17").Value
End Sub

(エラーが出ない場合は文字列が長すぎる可能性もありますが)
↓で原因が判るのではないでしょうか。

Sub test3()
  MsgBox TypeName(Range("L17").Value) & vbTab & CStr(Range("L17").Value)
End Sub

『Error エラー ####』
と表示されたらつまりRange("L17")がエラー値を返してるという事なのかな、と。
文字列とエラー値をくっつけようとして「型が一致しません」というエラーです。

数式の見直しをおすすめしますが
InitialFileName、つまりは初期設定値なのであまり気にしなくてよいのならとりあえずエラー値でも動く事優先で
fName = Application.GetSaveAsFilename(InitialFileName:="C\:~~~" & CStr(Range("L17").Value))
とすれば良いですよ :)
    • good
    • 1

No.4の方の回答に近いのですが、



>fname = Application.GetSaveAsFilename~
以下をExcel2007で動作すること確認しました。
たぶんご質問者様のねらいに近いのではないかと思いますが。

fname = "C:\" & Range("L17").Value
If Range("L17") = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=fname
End Sub
    • good
    • 0

確認はしていませんが



If fname <> "false" Then
ActiveWorkbook.SaveAs Filename:=fname
End If

の部分を

If fname = false Then Exit Sub
ActiveWorkbook.SaveAs Filename:=fname

に変更すればいいだけでは?
    • good
    • 0

№1で回答した者ですがお礼を受けて再回答します。



String(文字列型)で宣言したfnameにVariant型のデータ(GetSaveAsFilenameの戻り値はVariant型)を格納しようとしているのがエラーの原因です。

fname = CStr(Application.GetSaveAsFilename(InitialFileName:="C\:~~~" & Range("L17").Value))

にすれば、文字列型にデータが返還されるのでエラーを回避できるでしょう。
ここでファイル名入力をキャンセルした場合、格納されるはずのFalseも文字列になります。
次の行のIf文は"false"のままでは認識してくれないと思います。
今、ExcelのインストールされているPCが手元にないので確認できませんが、”False”か”FALSE”にする必要があるでしょう。
    • good
    • 0

確認ですが



Sheets("あいうえお").Copy

これは

Sheets("あいうえお").Select

の誤記ではありませんか?


あと、エラー発生個所(どこが黄色くなっているのか)を教えてください。
    • good
    • 0
この回答へのお礼

誤記ではありません。

>fname = Application.GetSaveAsFilename(InitialFileName:="C\:~~~" & Range("L17").Value)

この部分が黄色くなっていました。

お礼日時:2017/06/03 16:05

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています