エクセルVBAで作業改善

名称・管理番号・希望納期と依頼する部品名称と部品番号を入力します。
その時依頼する部品のデータを指定のフォルダに保存します。

プログラム内容1
Sub creordersheet()

Application.Run " M1"　’***M1を起動（M1は指定フォルダに入っているデータの読込）
Load UserForm4　　’***UserForm4を起動
UserForm4.Show

End Sub

ワンポイント
プログラムはApplication. RunでユーザーフォームはLoadで呼び出す

依頼書作成ボタンをクリックと見積もり用データ入力フォームが立ち上がります。

①A社～C社を選択して問合せ担当・見積担当を選択
②見積もり希望納期を入力しAM~当日中を選択
③図面データボタンを押すと指定フォルタに格納されたデータを表示データを選択して。
④実行ボタンを押す。

プログラム内容2
CheckBoxの内容で見積もり社名を確認

Private Sub CommandButton1_Click()

Dim zumend, zumenf
zumend = ListBox1
mnou = TextBox1
If CheckBox1 <> True And CheckBox2 <> True And CheckBox3 <> True Then　　’***チェックボックスにチェックが入っているかっ確認見積もり依頼する会社を認識します。
MsgBox “見積もり社名が未入力です。”
UserForm4.Show
GoTo G

End If

データが澪選択場合入力前に戻ります。

If ComboBox1.Value = “” Or ComboBox2.Value = “” Then
MsgBox “担当者名が未入力です。”
UserForm4.Show
GoTo G

End If

If zumend = “” Then
MsgBox “図面データが未選択です。”
UserForm4.Show
GoTo G

End If

オプションボタンの選択により時間帯を選択した内容の確認

If OptionButton1 = True Then
mn = “AM中”
ElseIf optionbotton2 = True Then
mn = “15:00迄”
ElseIf OptionButton3 = True Then
mn = “中”
Else
mn = “中”
End If

入力データをエクセルフォーマットに書き込み

Dim oApp As Object
Dim objMAIL As Object
Dim strMOJI(1) As String
Dim a, b
odname = Cells(2, 2)
odno = Cells(3, 2)
nou = Cells(4, 2)
tantt = ComboBox1.Text
tanto = ComboBox2.Text

If CheckBox4 = True Then
zumen = “正式図面です。”
Else
zumen = “見積用の図面です。”
End If

‘If OptionButton5 = True Then

L:

lastr = Cells(Rows.Count, 1).End(xlUp).Row

WB1 = ActiveWorkbook.Name

‘手入力の場合
‘##################手動####################
‘If OptionButton1 = True Then

a = lastr – 6
Range(Cells(6, 1), Cells(lastr, 1)).Select
Selection.Copy

Workbooks.Open Filename:=”\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\ベース類外注注文書v4.xls”
Worksheets(1).Activate

WB2 = ActiveWorkbook.Name

Cells(22, 3) = odno
Cells(22, 9) = odname
Cells(16, 34) = tanto
Cells(5, 29) = Date
Cells(3, 39) = “1”

k = 0
Do Until k = a + 1
Cells(22 + k, 3) = odno
Cells(22 + k, 9) = odname
Cells(22 + k, 34) = nou
k = k + 1
Loop

Cells(22, 14).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Workbooks(“” & WB1 & “”).Activate
Range(Cells(6, 4), Cells(lastr, 4)).Select
Selection.Copy

Workbooks(“” & WB2 & “”).Activate
Cells(22, 21).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Cells(43, 20) = “” & mnou & mn & ” にお見積りお願いします！”””

Call 見積依頼書作成

GoTo X

‘ここからは一緒
省略

Call 見積依頼書作成

X:

所のフォルダにに新たに名前を付けたフォルダを作成
‘フォルダ作成
MkDir “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\” & odname & “_ ” & odno & “見積り依頼”
‘テキスト作成
‘Open “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\” & odname & “相見積り\” & odno & “” & odname & “ベースDXF.txt” For Append As #1
‘Close #1
‘Open “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\” & odname & “相見積り\” & odno & “” & odname & “ベース組図PDF.txt” For Append As #2
‘Close #2

zumend = ListBox1
zumenf = ListBox2

If CheckBox1 = True Then

見積もり依頼書PDFの作成

‘PDF作成
Worksheets(2).Activate
保存名1 = “見積依頼書_A様” & odname & “”

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "\\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\" & odname & "_ " & odno & "見積り依頼\" & 保存名1 & ".PDF", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False

‘メール作成
Set oApp = CreateObject(“Outlook.Application”)

Set objMAIL = oApp.CreateItem(0)

strMOJI(0) = “A(株)AAA栗 様” & vbCr & vbCr & _
“いつも大変お世話になっております。” & vbCr & vbCr & _
“【新規加工見積り依頼】” & vbCr & _
“　” & odno & ” ” & odname & “” & vbCr & _
“　希望加工納期　” & nou & “弊社着” & vbCr & _
“　加工の御見積りをお願いします。” & vbCr & _
“　※添付図面は、” & zumen & “” & vbCr & _
“” & vbCr & _
“図面等の問い合わせは、【” & tantt & “】宛てにお願いします。” & vbCr & _
“お見積りは、” & mnou & mn & “にお願いします。” & vbCr & _
“よろしくお願いいたします” & vbCr & vbCr & _
“(株)DDD　” & tanto & “” & vbCr & _
“”

‘strMOJIにメール本文(body)を定義。以降を簡素化でき見やすくする。
‘& vbCr & vbCr & で改行二回 ‘& vbCr & で改行一回

objMAIL.To = “相手先アドレス”
‘To
objMAIL.CC = “CC先アドレス’cc
‘objMAIL.BCC = “BCC先アドレス”
‘BCC
objMAIL.subject = “【新規加工見積り依頼】” & odno & “” & odname & “”
‘件名
objMAIL.BodyFormat = 2
‘HTML形式
objMAIL.Body = strMOJI(0)
‘メール本文
objMAIL.Attachments.Add “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\” & odname & “_ ” & odno & “見積り依頼\” & 保存名1 & “.PDF”

If zumend <> “” Then
objMAIL.Attachments.Add “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\図面データ\” & zumend & “”
Else
End If

If zumenf <> “” Then
objMAIL.Attachments.Add “\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\図面データ\” & zumenf & “”
Else
End If
‘メール添付ファイル
‘objMAIL.display
‘表示
objMAIL.Save
objMAIL.display

End If

‘メール作成２

同様の為省略

MsgBox “メールを保存しました。内容を確認してください。”

ActiveWorkbook.SaveAs Filename:=”\Fileserver01\全社\01-技術部\15_設計注文書\モールドBASE注文\” & odname & “_ ” & odno & “見積り依頼\” & odname & “_ ” & odno & “.xls”

‘End If ‘##################自動完了####################

‘以下共通処理

Unload Me

‘Application.ScreenUpdating = True

G:

End Sub

①メールは自動せ作成してくれます。
・事前の入力情報から見積もり相手先、加工希望納期、問合わせ担　当、見積もり希望日、見積もり担当者を記載したメールを作成して選択したファイルを添付してくてます。
②PDFで作成した見積もり依頼書自動で作成添付してくれます。
・メールアドレスも相手先情報から判断し自動で入力したメールを作成してくれます。
この時選択したすべての相手先えのメールが作成されOUTLOOKの下書きに保存されます。
②表示されたメールを送信するか、OUTLOOKを開いて送信する事で見積もり依頼完了をなります。

見積依頼書のデータも自動で作成してくれます。
エクセルデータにすべての見積依頼書データを作成します。
作成したデータは指定にフォルダに名前を付けてPDFを一緒に自動で保管されます。
のちにこのデータから注文書を作成して発行、注文依頼まで完了させます。