エクセルマクロ

下記のマクロでシートa1に今回の見積もり番号が表示されるようにアレンジしたいです。
どなたかお知恵をお願いします。

初の設定だけ少し手順が必要ですが
それ以降はボタン１つなのでご協力下さい。
もしもの場合に備えてバックアップをとってから実施して下さい。


では以下の手順でお願します。


「マクロの貼り付け」
「準備」
「実行」



「マクロの貼り付け」
１．見積のブックを開いて
２．Alt ＋ F11 を押して VBE を起動して下さい。
３．ツールバーの「挿入」－「標準モジュール」
を選んで下さい。
４．出てきた白紙に下のソースを貼りつけて下さい。
５．ツールバーの「ファイル」－「終了してエクセルに戻る」
を選択してエクセルに戻って下さい。



「準備」
１．見積書のシート名を「見積」に変えて下さい。
２．ツールバーの
「ツール」－「マクロ」－「マクロ」を選んで
中から「準備」を選択して、実行して下さい。


これで準備完了です。



「実行」
表示された表に
１．会社名
２．支店名
３．パス
を入れて下さい。

１．会社名は実際にあるフォルダの名前を入力下さい。
まだ実際にフォルダが無い場合は、作成後に入力下さい。
３．パスは実際に１の会社名フォルダのある場所を記入下さい。
１と３はそれぞれディスク上に無いとエラーになります。



見積を作成後、スタートボタンを押して下さい。
設定のままだと下の場所に作られます。
例
C:\WINDOWS\日本株式会社\0001アフリカ支社.xls





「注意点」

１．「設定」では、会社名、支店名、パス以外は変更しないで下さい。
行や列の移動や削除は行わないで下さい。

２．シート「見積」は、名前を「見積」以外にしないで下さい。

３．準備作業は最初の1回だけ行って下さい。
２回やるとエラーになります。
（もし行う場合は、シート「設定」を削除してから行って下さい。）

４．登録するフォルダは事前に作っておいて下さい。
実行後に、実在しないフォルダが指定されているとエラーになります。

５．見積番号は、自動連番です。
1度スタートボタンを押すと、番号が１つ進みます。
もしも番号を操作する場合（一つ戻す、リセットするなど）は、
シート「設定」の非表示にしてある２行目の数字
「前回見積No.」を変更して下さい。
他は計算式が入っているので注意下さい。


スタートボタンは右クリックするとコピーができます。
場所やシートを移動する場合は、適当な位置へ動かして下さい。

その他何かあれば小さなことでも構いません、連絡下さい。



下をコピーして貼りつけて下さい。

Sub 見積連番保存()

見積番号 = Sheets("設定").Cells(4, 4)
会社名 = Sheets("設定").Cells(6, 4)
支店名 = Sheets("設定").Cells(7, 4)
パス = Sheets("設定").Cells(8, 4)
フルパス = パス & 会社名 & "\" & 見積番号 & 支店名 & ".xls"

Sheets("見積").Select
Sheets("見積").Copy
ActiveWorkbook.SaveAs FileName:=フルパス
ActiveWorkbook.Close

Sheets("設定").Cells(2, 4) = 見積番号
ActiveWorkbook.Save

Sheets("設定").Select
MsgBox "見積書を保存しました。 " & フルパス
End Sub
Sub 準備()
Sheets.Add
ActiveSheet.Name = "設定"

Range("C2") = "前回見積No."
Range("C4") = "今回見積No."
Range("C6") = "会社名"
Range("C7") = "支店名"
Range("C8") = "パス"
Range("C10") = "予定ファイル名"
Range("C11") = "予定登録先"
Range("D2").FormulaR1C1 = "0"
Range("D3").FormulaR1C1 = "=+R[-1]C+1"
Range("D4").Formula = "=REPT(0,4-LENB(D3))&D3"
Range("D6") = "日本株式会社"
Range("D7") = "アフリカ支社"
Range("D8") = "C:\WINDOWS\"
Range("D10").Formula = "=REPT(0,4-LENB(D3))&D3&D7"
Range("D11").Formula = "=D8&D6&""\""&REPT(0,4-LENB(D3))&D3&D7&"".xls"""
Range("E2") = "変更不可"
Range("E3") = "変更不可"
Range("E4") = "変更不可"
Range("E10") = "変更不可"
Range("E11") = "変更不可"
'青
Range("B5:C9,D5:E5,D9:E9,E6:E8").Select
With Selection.Interior
.ColorIndex = 34
End With
'グレー
Range("B2:E4,B10:E11").Select
With Selection.Interior
.ColorIndex = 15
End With
'太字
Range("C2:C4,C10:C11").Select
Selection.Font.Bold = True
'１６ポイント
Range("D6:D8").Select
With Selection.Font
.Name = "ＭＳ Ｐゴシック"
.Size = 16
End With
'中中
Range("C6:C8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'height
Rows("6:8").Select
Selection.RowHeight = 30
'width
Columns("A").ColumnWidth = 1.88
Columns("B").ColumnWidth = 7.38
Columns("C").ColumnWidth = 14.5
Columns("D").ColumnWidth = 51.5
Columns("E").ColumnWidth = 8.75
'グループ化 非表示
Rows("2:3").Select
Selection.Rows.Group
Selection.EntireRow.Hidden = True
'罫線
Range(Cells(6, 3), Cells(8, 4)).Borders.LineStyle = xlContinuous
Range(Cells(4, 2), Cells(11, 5)).BorderAround xlContinuous

'ボタン作成
Range("C13").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 63, 211.5, 90.75, 54).Select
Selection.ShapeRange.Shadow.Obscured = msoTrue
Selection.ShapeRange.Shadow.Type = msoShadow18
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45
Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 2, 1#
Selection.Characters.Text = "" & Chr(10) & "スタートボタン"
With Selection.Characters(Start:=2, Length:=7).Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "太字"
.Size = 16
.ColorIndex = 7
End With
Selection.HorizontalAlignment = xlCenter
Selection.ShapeRange.ScaleWidth 1.31, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.89, msoFalse, msoScaleFromTopLeft
Selection.OnAction = "見積連番保存"
Range("D13").Select
ActiveWorkbook.Save
End Sub

No.2 ベストアンサー 回答者： Zincer 回答日時： 2017/01/16 22:15

書き込む場所は「sheets(”見積”）のセルA1」でいいんですね？

＞sheets(”見積”）のセルA1であり、そこが空であるならば、・・・
の責任はありますかね？

～～～～～～～～～～～～～～～～
フルパス = パス & 会社名 & "\" & 見積番号 & 支店名 & ".xls"
Sheets("見積").Range("A1") = 見積番号　’←ここを追加
Sheets("見積").Select
～～～～～～～～～～～～～～～～

注意
Sheets("見積")の内容を確認していないので、他の部分がどうなるかは責任もてません。

「見積番号」は4桁の文字列に合わせているようですが、型の指定が一切されていないのでセルの書式によっては、通常の数字になる可能性があります。

では、ご検討をお願いします。

この回答へのお礼

先ほどの失礼な発言大変失礼いたしました。病んでいたんで勘弁してください。ご指示内容で完璧にできました。。ありがとうございます。また助けてくださいね。

お礼日時：2017/01/17 03:39

No.1 回答者： Zincer 回答日時： 2017/01/16 19:25

このコードを見る限り、sheets(”見積”）へ情報を書き込む操作は行われていません。

おそらく、sheets(”見積”）内は 「Sheets("設定")への参照」および「計算式」等が書き込まれているものと思われます。

＞下記のマクロでシートa1に今回の見積もり番号が表示されるようにアレンジしたいです。
sheets(”見積”）のセルA1であり、そこが空であるならば、何とかできそうですが、

＞他は計算式が入っているので注意下さい。
＞その他何かあれば小さなことでも構いません、連絡下さい。
とありますので、素直に相談されてはいかがでしょうか？

この回答へのお礼

あの、NO.1さん素直にお伺いできればそうしてるんですけど。答えていただいた神様が音信ふつうだからこうしていろいろと聞いてるんです。質問していて申し訳ないんですが、なんかこういう身も蓋もない回答もらうと気持ちも下がりますね。悲しいです。

お礼日時：2017/01/16 19:58