Ｅｘｃｅｌ VBA シートのコピー時に、シート上のコンボボックスもコピーしたい。

こんにちは。
Excel VBAについて質問させていただきます。
やりたいことは、
シートＡにボタンとコンボボックスを配置し、
コンボボックスには氏名の一覧を設定しています。
そこで、ボタンを押すとシートＡをボタンとコンボボックスごと
シートＢという名前でコピーをしたいと思っています。

ActiveSheet.Copy Before:=Worksheets(1)
でシート・ボタン・コンボボックスのコピーはうまく出来たのですが、
コンボボックスに設定していた氏名の一覧はコピーされていませんでした。

コピー先のシートのコンボボックスにもう一度氏名の一覧を
設定するしかないのでしょうか？
それともシートのコピー時に何かいい方法があるのでしょうか。

宜しければアドバイスをお願い致します。
OSはWindows2000Pro
Excelは2000です

No.2 ベストアンサー 回答者： onlyrom 回答日時： 2007/01/20 00:18

こんばんは。

再度の登場です。

先の回答は、ListFillRangeプロパティを使用したものですのでコピーしても値は保持されますが、
質問者のように、AddItemメソッドでセットしたものはコピーしても保持されませんので改めてセットする必要があります。

現在”コンボボックスの中身もコピー”されてるようですが、
その中身のコピーを実行するタイミングを誤ると上手くいかない場合があります。
シートのコピーと同時に”中身のコピー”をするとそれは一見上手くいってるようでも
ブックを閉じて再度開いたときにはクリアーされますので、
コピーしてできたシートがActiveになるたびにそのシートのComboboxにも値をセットしなければいけません。
WorkBookOpenイベントでセットしているのは「元のComboboxにのみ」Listをセットしているわけですから。

●要約●
以下、コピーされてできた新しいシートは、見積書２、とする
（方法１）
「見積書２」がアクティブになる度に「見積書」のComoboxのListをコピーする
（方法２）
WorkbookのOpenイベントの”Function SetComboBox()”を標準モジュールへ移し、
「見積書」「見積書２」それぞれのActivateイベントで、”Function SetComboBox()”を呼び出す
その場合、”Function SetComboBox()”のComboboxのコンテナである固有のシート名は使わずに、ActiveSheetに変更しておく
（方法３）
WorkBookのOpenイベントでは、リスト一覧を配列変数に作成しておき
「見積書」「見積書２」がActiveになったときそのシート上のComboBoxのListに配列変数をセットする
　
●もし興味があれば、配列変数をListプロパティに直接セットするコードをアップしてもいいのですが。。。
　
それから、敬称Comboのリストは決まっているようですから、
別なシートのどこかのセルに一覧を作っておき、
ListFillRangeプロパティにセットしておけばいいですね。

以上です。

　

No.3 回答者： onlyrom 回答日時： 2007/01/20 11:03

おはようございます。

追加です。

（方法４）
敬称Comboだけではなく、顧客ComboもListFillRangeを使う方法もありますね。
別シートに、敬称リスト、顧客リストを作成しそれを利用するわけですが、
敬称は予めセットしておけばいいでしょうから、顧客Comboのみの説明にします。

以下、別シートを「一覧シート」と呼びます。
"Function SetComboBox"で、「顧客名」シートから「一覧シート」に、必要な値を作成し、
顧客Combo.ListFillRange = "一覧シート!A1:B" & 「一覧シート」の最終行
としておけばコピーしても引き継がれます。
　

●コードの他の部分をみてないので何なんですがちょと思ったこと

現在はWorkBookイベントでComboへリストをセットしているみたいですが
色々な処理の途中で「顧客マスタ」の修正削除追加はないのでしょうか
そういったことは普通ありそうに思えますが、
いまのままではその変更は顧客Comboにリアルタイムには反映されませんよね。

今朝は暇なのでだらだらと余計なことを書いてしまいました。(^^;;;
以上です。
　

この回答へのお礼

すごくお礼が遅れてしまって申し訳ありませんでした。
教えていただいた方法で解決できました☆
Comboへの顧客マスタの反映はブックを開く時に
全てのシートに対して行なうようにしてみました。

顧客マスタへの反映は、、、やりたかったですけど、
とりあえずは参照だけにしておきました。
きちんと一通りのマスタ等を作ろうと思ったら、
Accessの方がいいのかなぁと思いまして。
今回はExcelのVBAがどんなものかを知りたくて作ってみましたから。
次はAccessで画面を作ってやってみたいなぁと思っています。

とても丁寧に何度も書き込んで頂いたのに、
お返事が遅くなって本当に申し訳ありませんでした。
またもし別の質問を見つけられたときは、
どうぞ宜しくお願いします。

お礼日時：2007/03/07 18:33

No.1 回答者： onlyrom 回答日時： 2007/01/16 16:46

こんにちは。

＞コンボボックスに設定していた氏名の一覧はコピーされていませんでした

その方が不思議な現象です。(^^;;;

一覧の設定はどうしたやりましたか。
一覧のあるシートなど実際のシート名、その方法をアップしてください。
そのボタン、コンボボックスは、フォームツールバーからのものでしょうか、
あるいは、コントロールツールボックスからのものでしょうか。
またそれらのコードはどこにおいてますか、標準モジュール、シートモジュールなど

情報は多いほうがいいですので上記補足してください。

以上です。

この回答への補足

お返事ありがとうございます。
補足が遅れて申し訳ありませんでした。

(1)一覧の設定は「ThisWorkBook内のオープンイベント」で
　「同じThisWorkBook内の下記のSetComboBox関数」を呼び出して
　AddItemのListで設定しています。
　設定するデータの元はブック内の別のシートからです。
(2)ボタン等はコントロールツールボックスから貼り付けました。
(3)無理やりコピー前のシートから一覧もコピーするようにしましたが、
　シートのコピーだけで出来ないのかと思いまして。。

'コンボボックスの中身もコピー
ActiveSheet.cboCliantName.List = Sheets(strSaveSheetName).cboCliantName.List '顧客名


Private Function SetComboBox()

Dim intI As Integer 'ループカウンタ
Dim objSheet As Worksheet 'ワークシートオブジェクト
Dim strRange As String 'セル範囲
Dim intSetPos As Integer 'コンボボックスのセット位置

SetComboBox = False

For Each objSheet In Worksheets
'「見積書」のシートであれば設定
If InStr(1, objSheet.name, SHEET_NAME_MITSUMORI) > 0 And IsNull(InStr(1, objSheet.name, SHEET_NAME_MITSUMORI)) = False Then
With Sheets(objSheet.name)

'-----------------------------
'顧客名称コンボボックスの設定
'-----------------------------
.cboCliantName.ColumnCount = 2 'カラム数
' .cboCliantName.ColumnWidths = "100;500" 'カラム幅
.cboCliantName.TextColumn = 2 '表示させるカラム
.cboCliantName.Style = fmStyleDropDownCombo

'顧客名コンボボックスの参照元範囲設定をクリア
.cboCliantName.ListFillRange = ""

'----最上段には空欄をセット----
.cboCliantName.AddItem
'顧客番号をセット
.cboCliantName.List(0, 0) = ""
'顧客名称をセット
.cboCliantName.List(0, 1) = ""

intSetPos = 1
For intI = 0 To CRIANT_MAX_REC_CNT - 1
'顧客番号が空欄でなければ、コンボボックスに追加
strRange = "A" & Trim(CStr(4 + intI))
If Sheets(CLIENT_SETTING_SHEET_NAME).Range(strRange).Value <> "" Then
.cboCliantName.AddItem
'顧客番号をセット
.cboCliantName.List(intSetPos, 0) = Sheets(CLIENT_SETTING_SHEET_NAME).Range(strRange).Value
strRange = "B" & Trim(CStr(4 + intI))
'顧客名称をセット
.cboCliantName.List(intSetPos, 1) = Sheets(CLIENT_SETTING_SHEET_NAME).Range(strRange).Value
intSetPos = intSetPos + 1
End If
Next intI

'-----------------------------
'敬称コンボボックスの設定
'-----------------------------
.cboKeisyou.ColumnCount = 1
.cboKeisyou.Style = fmStyleDropDownCombo
.cboKeisyou.AddItem "殿"
.cboKeisyou.AddItem "様"
.cboKeisyou.AddItem "御中"
End With
End If
Next

SetComboBox = True

End Function

補足日時：2007/01/18 11:16