VBAの記述方法

質問

毎月下記のような処理をしたい。
(1)． ３０シートの中からその月に必要なシートのみを別ブックにコピーし作成する
(2)． (1)で作成したシートの不要行（A列B列）を削除する
(3)． (1)で作成したシートのマクロボタン（５個）を削除する
(4)． (1)で作成したシートのリンクを削除する（コピー元のリンクは保持）

その為に下記のようなマクロを作ってみました
Sub リンク解除()
マクロ記録日 : 2006/3/4 ユーザー名 : isekaoru
(1)． ActiveWorkbook.ActiveSheet.Copy
(2)． Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
(3)． ActiveSheet.Shapes("AutoShape 4").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 5").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 3").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 2").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 1").Select
Selection.Cut
(4)．ActiveWorkbook.BreakLink Name:= _
"C:\Documents and Settings\ isekaoru\My Documents\１７年度計表 .xls" _
, Type:=xlExcelLinks
Range("A1").Select
End Sub

御教示頂きたき事
１．多数のブックに共通で使用出来るようにしたい
２．(2)～(3)のマクロ本来の記述方法
３．(4)の共通に使用出来る記述方法
* 編集（E)→リンクの設定（K)→リンクの編集画面のリンクの解除（B)をマクロに写したものです。
VBAの記述は出来ない初心者です、御指導宜しくお願い致します。

回答No.4

imogasi · ベストアンサー

＞VBAの記述は出来ない初心者です、
とおっしゃっているが（その通り、selectの多用などマクロの記録をするレベルのように見える）、問題そのものは、上級の問題のように思います。他ブックにわたると、色々難しいことが出てくると思います。
最近エクセルの質問で、初心者なのに、頭だけ・したいことだけ前に進んで、難しい質問を出している例が多いようです。難しいかどうかも、勉強しないとわからないので、言ってもしょうがないのですが。
ーーーー
質問を私なりに表現すると、
今開いているるブック（３０シート程ある）の、あなたが選んだ1つだけのシートを、別の新規ブックをつくり、そのブックの１つのシートに貼り付ける。
新規ブックの貼り付けた先のシートで、質問の（２）、（３）、（４）の処理をして、新規ブックに名前を受けて、フォルダを指定して、保存したいようですね。
これでよいですか。
選ぶシートは、毎月多いのでしょうか、一斉にしたいのか、個別実行で良いのでしょうか、書いてない。
＞多数のブックに共通で使用出来るようにしたい
この意味がどういうことかわからない。
ーーーーー
Sub test01()
Dim NB As Workbook
Set NB = Workbooks.Add
'------コピー
Workbooks("Change範囲.xls").Activate 'A
Worksheets(1).Range("A1:H40").Copy 'B
'------貼り付け
NB.Worksheets(1).Activate
ActiveSheet.Paste
'-----修正
With ActiveSheet
.Columns("A:B").Delete
.DrawingObjects.Delete '全ての貼り付けオブジェクト削除でよいとき C
.Cells.Hyperlinks.Delete '全ての貼り付けオブジェクト削除でよいとき D
End With
'------保存
NB.SaveAs "NewBook.xls" 'E
Workbooks("NewBook.xls").Close
Application.CutCopyMode = False
End Sub
このA,B,C,Dは固定（上記）でよいのか、質問と違うのか、その都度指定するのか。それによっては、また一段と難しくなりったり、チェックが必要になります。
http://www.moug.net/skillup/nksw/nksw03-01.htm
を参考にしましたが、このMougの本やWEBで言っていること（これ以外の事項も）身近になるレベルになればこういう質問をVBAでやる段階になったということ思います。

お礼

御指導有難う御座いました。

補足

要領の得ない質問にに対し、長文の御指導、御叱責賜りました事厚く御礼申し上げます。
質問者としては、行と列を間違うなど大変なミスをしてしまいました。
深くお詫び申しげます。

初心者なのに、頭だけ・したいことだけ →御叱責の通りその最たるものです。
質問を私なりに表現すると、 → はい、その通りです。
個別実行で良いのでしょうか、→ はい
＞多数のブックに共通で使用出来るようにしたい
３．(4)の共通に使用出来る記述方法
(4)．ActiveWorkbook.BreakLink Name:= _
"C:\Documents and Settings\ isekaoru\My Documents\１７年度計表 .xls" _
, Type:=xlExcelLinks
* 編集（E)→リンクの設定（K)→リンクの編集画面のリンクの解除（B)をマクロに写したものです。
この部分｛ "C:\Documents and Settings\ isekaoru\My Documents\１７年度計表 .xls" _｝が
異なるブック名でも同じ名前で記述する事が可能でしょうかという意味です。
このブック（名称A）の１シートからコピーして新しいブックを作成する時、
新しいブックに、このブック名が記述されていますが、このリンクを解除したい。
次に、異なる名前のブック（名称B）を同様の処理をする時、
（名称A）のVBAを（名称B）に貼付けて処理をしたいという意味です。
ブックが異なる都度、変更しなくても良い代名詞のような記述の方法がありますかと言う意味です。
くどくなってしまい申し訳御座いません

個人的な事情（年齢等・・・）もあり、VBAで記述するような事は、これが最後だと思いますので、
方法が有るのか、無いのか、有れば記述を御教示下さい。
宜しく御願い致します。

回答No.5

Wendy02

#3のWendy02です。

書き忘れていましたが、Ctrl キーを押しながら、シートタブをクリックして、複数のシートを選択してから、マクロを起動させます。

起動させるのは、当面は、F8 で、マクロ名を選んでクリックすればよいのですが、最終的に、それでよいとなったら、

表示－ツールバー－ユーザー設定
コマンド(タブ）－マクロ－ユーザー設定ボタン
ドラッグして、メニューバーに持ってきて、そのまま、右クリック－選択したボタンの編集－マクロの登録

で登録させます。

そこまでには、長い道のりになるかもしれませんが、がんばってくださいね。

お礼

要領の得ない質問にに対し、長文の御指導、励ましのお言葉有難う御座いました。

また、御多忙のところ、２度にわたり、御指導頂きました事厚く御礼申し上げます。

回答No.3

Wendy02

こんばんは。

ご自身で考えようとされている方なら、いずれは、何とかなると思います。

ただ、今、私は、別のことをやって集中力をなくしているので、自信がまるっきりありません。どこかにミスがあるかもしれませんが、ご質問の内容が、解決までにはなかなか道が遠そうなので、サンプルを作ってみました。

＞１．多数のブックに共通で使用出来るようにしたい
は、Personal.xls の標準モジュールに登録して、ツールボタンなどにつければよいのではないでしょうか？

後は、ActiveBook とそうでないブックの違いなのですが、他のブックが開かれていなければ、新たにブックを作り、そうでなければ、目ぼしいひとつにコピーされるという仕組みを考えました。ですから、確実にするには、ブックは二つ開けてください。それ以上ですと、開いた順のブックが設定されてしまいます。

ActiveBookが、コピーされる側になった場合は、データがある場合はコピーされないように作っています。あくまでも、参考程度にしてください。

'<Personal.xls の標準モジュール>
'---------------------------------------------------
Sub SelectedSheetCopy()
　 Dim OpWb As Workbook
　 Dim sh As Object
　 Dim Shts As Sheets
　 Dim i As Long
　 Dim j As Long
　 Dim CopyFlg As Boolean
　 Dim cnt As Long
　 Const LINKNAME = "C:\Documents and Settings\ isekaoru\My Documents\１７年度計表 .xls"

　 On Error Resume Next
　 Set Shts = ActiveWindow.SelectedSheets

　 For i = 1 To Workbooks.Count
　　　If Not StrConv(Workbooks(i).Name, vbLowerCase) Like "personal.*" Then
　　　　 If Workbooks(i).Name <> ActiveWorkbook.Name Then
　　　　　　Set OpWb = Workbooks(i)
　　　　 End If
　　　End If
　 Next i
　 If OpWb Is Nothing Then
　　　If MsgBox("もう1つのブックが開いていないので、新たに作りますか？", vbInformation + vbOKCancel) Then
　　　　 Set OpWb = Workbooks.Add
　　　　 Else
　　　　 Exit Sub
　　　End If
　 End If
　 '空白のシートを探す
　 Do
　 For j = OpWb.Sheets.Count To 1 Step -1
　　　If WorksheetFunction.CountA(OpWb.Worksheets(j).Cells) > 0 Then
　　　　Exit Do
　　　End If
　 Next
　 Loop Until j = 0
　 j = j + 1
　 For Each sh In Shts
　　　CopyFlg = False
　　　If OpWb.Worksheets.Count >= j Then
　　　　 If WorksheetFunction.CountA(OpWb.Worksheets(j).Cells) = 0 Then
　　　　　　sh.Cells.Copy OpWb.Worksheets(j).Range("A1")
　　　　　　cnt = cnt + 1
　　　　　　CopyFlg = True
　　　　 End If
　　　　 Else
　　　　 OpWb.Worksheets.Add After:=OpWb.Worksheets(j - 1)
　　　　 If WorksheetFunction.CountA(OpWb.Worksheets(j).Cells) = 0 Then
　　　　　　sh.Cells.Copy OpWb.Worksheets(j).Range("A1")
　　　　　　cnt = cnt + 1
　　　　　　CopyFlg = True
　　　　 End If
　　　End If
　　　If CopyFlg Then
　　　　 WorksheetArrange OpWb, j
　　　End If
　　　j = j + 1
　 Next sh
　 OpWb.BreakLink Name:=LINKNAME, Type:=xlExcelLinks
　 MsgBox CStr(cnt) & "枚のシートをコピーしました!"
　End Sub

Sub WorksheetArrange(wb As Workbook, j As Long)
　With wb
　 .Worksheets(j).Columns("A:B").Delete Shift:=xlToLeft
　 On Error Resume Next
　 .Worksheets(j).Shapes.Range(Array(1, 2, 3, 4, 5)).Delete
　 On Error GoTo 0
　 Application.Goto .Worksheets(j).Range("A1")
　End With
End Sub
'---------------------------------------------------

回答No.2

merlionXX

多数のブックに共通で使用は出来ないと思いますが・・・。
現在のシートを新たに作成された別ブックにコピーし、要望の動きをするマクロのサンプルを作成してみました。

Sub TEST01()
With ActiveSheet
.Columns("A:B").Delete
.DrawingObjects.Delete
.Cells.Hyperlinks.Delete
.Copy
End With
ActiveWindow.Close
End Sub

回答No.1

Yosha

大変お困りのようですが、あなたのご質問に直接お答えすることに躊躇します。何故かといえば、質問の内容に不備があります。例えば
>１．多数のブックに共通で使用出来るようにしたい
とありますが、あなたの書かれているマクロの >ActiveWorkbook.ActiveSheet.Copy は
実行してみるとわかりますが、新規のブック（ブック名はエクセルが勝手につけます）に選択したシートがそのままコピーされます。すなわち、「多数のブックに共通で使用出来るように・・・」したいのなら、引数に具体的なブック名、シート名が必要となります。
また、(2)の >Columns("A:B").Select Selection.Delete Shift:=xlToLeft も 自動でマクロを作らせるとこうなりますが、Select を省いて
Columns("A:B").Delete Shift:=xlToLeft でも同じ結果になります。更に Shift:=xlToLeft も省けます。しかし目的によっては Select も Shift 以降も省かないほうが良いときもあります。それに 近い将来、Columns("A:B") も n=2 Range(Columns(n),columns(n + 1)) と変数で列を指定することが必要となります。
だから、ここで何とか汎用のマクロを作り、お教えしても理解できなくてまた質問を、その回答が理解できなくてまた質問をと繰り返す結果にもなりかねません。

そこで、まずテスト用のマクロで各項目を１つずつ実際に動かしてどうなるかを自分で確かめて見るようにしましょう。そのとき必要なのが VBA Super Master のような参考書です。エクセルのヘルプでもありますが、かなりの下勉強をしないと多分これが理解できないと思います。また、ＶＢＡで検索すると多数のＷｅｂが引っかかります。これらにはいろいろと具体的に記述さてたものが多くあり大変役立ちます。

揚げ足を取るようですが、>(1)で作成したシートの不要行（A列B列）を削除する は「不要列」です。行(横並び)と列(縦並び)とを言葉の上でもはっきり区別するようにしましょう。混乱を招きかねません。ミスをおかす原因の１つとなります。

くどくど書きますたが、要は、自分でマクロの動作を確かめるのが原点になります。そして同じマクロでも何通りの記述方法があります。自分でちゃんと動くまで手直しをする。その上どうしても助けが必要なときは、その部分だけをなるだけ具体的に質問されることをお奨めいたします。そうすればきっと多くの回答が寄せられると思いますし、結果も早く得られるのでないでしょうか。

ＶＢＡもけっこう奥が深いようです。いろいろやってみるしかありません。第１の関門を突破すればある程度までスーといけます。頑張ってください。

お礼

要領の得ない質問にに対し、長文の御指導、御叱責賜りました事厚く御礼申し上げます。
揚げ足を取るようですが> とんでも御座いません、質問者としては、行と列を間違うなど大変なミスをしてしまいました。
深くお詫び申しげます。

リンク解除はマニュアルで行います。有難う御座いました。