teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

tuiki

2018/01/12 01:58

投稿

jawa
jawa

スコア3020

answer CHANGED
@@ -26,4 +26,77 @@
26
26
  今回提示いただいたコードと、過去の質問にあったコードを組み合わせて動作確認してみましたが、当方の環境(Windows7、Excel2010)では指定したCSV内容がアクティブシート上に展開されました。
27
27
  正常動作と思えますが、やはり問題点を明確に記載いただいた方がよさそうです。
28
28
 
29
- 追記をお待ちしております。
29
+ 追記をお待ちしております。
30
+
31
+ ---
32
+
33
+ ---
34
+ 追記・コメントを受けて
35
+ ---
36
+ 確認メッセージしか表示されていないということは、問題のあるコードは
37
+ ```
38
+ Set Sheet1 = ActiveSheet
39
+
40
+ On Error Resume Next
41
+ Set activeCell = Selection
42
+ On Error GoTo 0
43
+
44
+ If Range("A1:D4") Is Nothing Then
45
+ MsgBox "セルが選択されていないため処理を継続できません", vbExclamation + vbOKOnly, "処理失敗"
46
+ Exit Sub
47
+ End If
48
+
49
+ csvBookPath = Application.GetOpenFilename(FileFilter:="CSV ファイル, *.csv?")
50
+ ```
51
+ この範囲に絞られますね。
52
+
53
+ 変数名の問題?
54
+ ---
55
+ このうち最初の2つの処理`Set Sheet1 = ActiveSheet`と`Set activeCell = Selection`についてですが、`Sheet1`や`activeCell`という変数名はどちらもExcelVBAでは予約語です。
56
+
57
+ こちらの環境では問題なく動作しているので何とも言えませんが、コードを読む際に誤解を招く可能性もあり、変数名としてはあまりふさわしくありません。
58
+ まずは変数名を変更してみてはどうでしょうか。(宣言や利用箇所を全て変更する必要があります)
59
+
60
+ Range("A1:D4") Is Nothing?
61
+ ---
62
+ 3つめのブロック`If Range("A1:D4") Is Nothing Then`ですが、Range範囲を直接指定しているのにNothingになる状況は考えにくく、あまり意味のない判定になっていると思います。
63
+ 過去の質問で提供されたコードでは`If activeCell Is Nothing Then`となっていたので、デバッグ目的か何かで変更されたままになっているのだと思います。
64
+ おそらくボタン自体がフォーカスされている状態でマクロを実行した場合に、Selectionからセル範囲を取れなくなるのを回避しようとしたのではないでしょうか。
65
+
66
+ 最後に選択されていたセルを取りたいのであれば、`Selection`ではなく予約語の方の`ActiveCell`で取得できます。
67
+
68
+ ```
69
+ 'Dim Sheet1 As Worksheet '廃止
70
+ 'Dim activeCell As Range '廃止
71
+ Dim shtPaste As Worksheet
72
+ Dim rngPaste As Range
73
+
74
+ '(中略)
75
+
76
+ 'Set Sheet1 = ActiveSheet
77
+ Set shtPaste = ActiveSheet
78
+
79
+ 'On Error Resume Next
80
+ 'Set activeCell = Selection
81
+ 'On Error GoTo 0
82
+ Set rngPaste = ActiveCell
83
+
84
+ 'If activeCell Is Nothing Then
85
+ If rngPaste Is Nothing Then
86
+ MsgBox "セルが選択されていないため処理を継続できません", vbExclamation + vbOKOnly, "処理失敗"
87
+ Exit Sub
88
+ End If
89
+
90
+ '(中略)
91
+
92
+ 'Sheet1.Unprotect
93
+ shtPaste.Unprotect
94
+
95
+ With csvSheet.UsedRange
96
+ 'csvSheet.Range(csvSheet.Cells(IIf(NEED_HEADER, 1, 2), 1), .Cells(.Cells.Count)).Copy activeCell
97
+ csvSheet.Range(csvSheet.Cells(IIf(NEED_HEADER, 1, 2), 1), .Cells(.Cells.Count)).Copy rngPaste
98
+ End With
99
+
100
+ ```
101
+
102
+ 根本のエラー原因にはまだたどり着いていませんが、ひとまずお試しください。