エクセルVBA ワークシート操作について

質問

エクセル２０００　VBAで
ワークシートが左から順番に
入力フォーム⇒加工費単価マスタ⇒出荷日報(原紙）と
３個あり４個目に出荷日報（原紙）をコピーしたワークシートを
入力して⇒テキストボックス１
（日付入力します出来れば、日付入力の指定方法⇒テキストボックスの入力制限方法も教えていただきたいです）に入力した名前を
ワークシートに付けて保存したいのですが？

翌日は　また左から４番目の位置にコピーされ
右に行くほど古い日付の順番にしたいです。

説明が不足していましたら連絡お願いします。

回答No.3

Nayuta_X · ベストアンサー

では、ご要望に応じて　一部変更しました。
どこが、違っているかは、調べてください。
理解力の向上も、勉強の内ですよ。

Private Sub CommandButton2_Click() '登録

On Error GoTo Errorcheck

Data_Check = (TextBox1.Text <> "" And TextBox2.Text <> "" And TextBox3.Text <> "")

If Data_Check = False Then
Kotae = MsgBox("データが入力されていません!!", vbOKOnly + vbCritical)
Re_Show = True
Else

Data_Check3 = (TextBox2.Text > 0 And TextBox2.Text <= 12)

If Data_Check3 = False Then
Kotae = MsgBox(TextBox2.Text & "月は、存在しません。!!", vbOKOnly + vbCritical)
Re_Show = True

Else

myStr = Nen & tuki & Hi ' 年月日

ab = ThisWorkbook.Sheets("出荷日報(原紙)").Next.Name '出荷日報(原紙)の右にシートが、ない時は、　False

If ab = True Then

Sheets("出荷日報(原紙)").Select
Sheets("出荷日報(原紙)").Copy Before:=Sheets(4)
ActiveSheet.Name = myStr

End If

End If

End If

Errorcheck:
Select Case Err
Case 91 ' 出荷日報(原紙)の右にシートが、ない時
Sheets("出荷日報(原紙)").Select
Sheets("出荷日報(原紙)").Copy After:=Sheets(3)
ActiveSheet.Name = myStr

Case 1004 '同じ　シート名が、ある時
Application.DisplayAlerts = False '削除する際に確認メッセージを出さない
ActiveWindow.SelectedSheets.Delete

MsgBox "同じシート名が、既に存在します。", vbCritical + vbOKOnly

End Select
Application.DisplayAlerts = True '削除する際に確認メッセージを出さない

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""

Me.Hide

End Sub

お礼

助かりました。
希望のとうり動きました。
変更をかけていただいた場所はわかるのですが、
現在１つ１つの役割を調べています。
色々なところで活用も出来ます。
本当にありがとうございました。

回答No.2

Nayuta_X

回答です。
Sheet3(出荷日報(原紙))
の下にある
ThisWorkbookをクリックして
下記コードを貼り付けします。
Private Sub Workbook_Open()
My_menu_bar
End Sub

次に
UserForm1を作成して

　　TextBox1と TextBox2と TextBox3を適当に作成して
　　同様に
　　CommandButton1 と CommandButton2　を作成します。
　　　　同様に
　　Label1と Label2と Label3と Label4　を作成したら
　　下記コードを貼り付けします。

Dim Data_Check3 As Boolean
Dim Data_Check As Boolean
Dim myStr As String
Dim Nen As String
Dim tuki As String
Dim Hi As String
Dim ab As Boolean

Private Sub CommandButton1_Click() ' 中止
End
End Sub

Private Sub CommandButton2_Click() '登録

Data_Check = (TextBox1.Text <> "" And TextBox2.Text <> "" And TextBox3.Text <> "")

If Data_Check = False Then
Kotae = MsgBox("データが入力されていません!!", vbOKOnly + vbCritical)
Re_Show = True
Else

Data_Check3 = (TextBox2.Text > 0 And TextBox2.Text <= 12)

If Data_Check3 = False Then
Kotae = MsgBox(TextBox2.Text & "月は、存在しません。!!", vbOKOnly + vbCritical)
Re_Show = True

Else

myStr = Nen & tuki & Hi ' 年月日

On Error Resume Next ' エラーが、あっても　次に進む

ab = Sheets("出荷日報(原紙)").Next.Name '出荷日報(原紙)の右にシートが、ない時は、　False

If ab = False Then
Sheets("出荷日報(原紙)").Select
Sheets("出荷日報(原紙)").Copy After:=Sheets(3)
ActiveSheet.Name = myStr

Else
Sheets("出荷日報(原紙)").Select
Sheets("出荷日報(原紙)").Copy Before:=Sheets(4)
ActiveSheet.Name = myStr

End If

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
ab = False

Me.Hide

End If
End If

End Sub

Private Sub TextBox1_Change()
Nen = TextBox1.Text
End Sub

Private Sub TextBox2_Change()
tuki = TextBox2.Text
Selection.NumberFormatLocal = "00"
End Sub

Private Sub TextBox3_Change()
Hi = TextBox3.Text
Selection.NumberFormatLocal = "00"
End Sub

Private Sub UserForm_Activate()

UserForm1.Height = 125.25
UserForm1.Left = 0
UserForm1.Top = 0
UserForm1.Width = 261.75
UserForm1.Caption = "年月の入力"
UserForm1.StartUpPosition = 2

TextBox1.Height = 20.25
TextBox1.Left = 54
TextBox1.Top = 30
TextBox1.Width = 36

TextBox2.Height = 20.25
TextBox2.Left = 120
TextBox2.Top = 30
TextBox2.Width = 36

TextBox3.Height = 20.25
TextBox3.Left = 186
TextBox3.Top = 30
TextBox3.Width = 36

CommandButton1.Height = 18
CommandButton1.Left = 42
CommandButton1.Top = 60
CommandButton1.Width = 54
CommandButton1.Caption = "中止"

CommandButton2.Height = 18
CommandButton2.Left = 114
CommandButton2.Top = 60
CommandButton2.Width = 54
CommandButton2.Caption = "登録"

Label1.Height = 14.25
Label1.Left = 96
Label1.Top = 32
Label1.Width = 15.75
Label1.Caption = "年"

Label2.Height = 14.25
Label2.Left = 162
Label2.Top = 32
Label2.Width = 15.75
Label2.Caption = "月"

Label3.Height = 14.25
Label3.Left = 36
Label3.Top = 6
Label3.Width = 144
Label3.Caption = "年月を入力して下さい。"

Label4.Height = 14.25
Label4.Left = 234
Label4.Top = 6
Label4.Width = 15.75
Label4.Caption = "日"

TextBox1.SetFocus

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = True
End Sub

次に　標準モジュールを追加して　下記を同様に　貼り付けます。

Const CMNUBAR = "Worksheet Menu Bar"

Sub Auto_Close()
' Application.Caption = ""
Application.Caption = ""
Set menu1 = CommandBars(CMNUBAR)
Application.Caption = ""
menu1.Reset
Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない
ActiveWorkbook.Close '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------
Sub My_menu_bar()

Set menu1 = CommandBars(CMNUBAR). _
Controls.Add(Type:=msoControlPopup)
menu1.Caption = "個人メニュ－"

With menu1
.Controls.Add Type:=msoControlPopup
With .Controls(1)
.Caption = "シートコピー"
.Controls.Add Type:=msoControlButton
.Controls(1).Caption = "シートコピーを、実行する"
.Controls(1).OnAction = "test"
End With

End With

End Sub

Private Sub test()

UserForm1.Show
End Sub

以上で、終わりです。

注意; コマンド　バーに、　個人メニュー　の文字が、追加されますので、そこを　クリックして見て下さい。
　　　尚、この　メニューは、Bookを閉じると　消えます。

　エラー処理は、一部しかしておりませんので、ご自分で考えて　ください。

補足

すごいです。
出来ました。
ありがとうございます。

本当に、本当にすみません。
ワークシート名が重複した場合は（重複しています開きますか？YES,NO）
以上の処理をするようにするには、何を追加すればよろしいでしょうか？

回答No.1

Nayuta_X

最初に
コピーの処理は、
　Sub fastonly()　'第一回目のみ実施します。
Sheets("出荷日報(原紙）").Select
Sheets("出荷日報(原紙）").Copy After:=Sheets(3)
End Sub

Sub Second_To_End()'第二回目以降ならこれを実行します。
'
Sheets("出荷日報(原紙）").Select
Sheets("出荷日報(原紙）").Copy Before:=Sheets(4)
End Sub

☆　日付入力します出来れば、日付入力の指定方法⇒テキストボックスの入力制限方法も教えていただきたいです）に入力した名前を
ワークシートに付けて保存したいのですが？

具体的に、どうしたいのですか??。
例;
1. 出荷日報 2007/05/22
2. 出荷日報 20070522
3. 出荷日報 2007年05月22日
4.　・・・・・

補足

ありがとうございます。
左から４番目に出荷日報（原紙)(2)
　　　　　　　出荷日報（原紙)(3)・・・が入力されるように
なりました。
あとは出荷日報（原紙)(2)
　　　出荷日報（原紙)(3)・・・をテキストボックス1に
入力した日付が入力されるようにですが
すみません　具体的に指定は20070522もしくは070522が希望です。
宜しくお願いいたします。