ちょっとだけかな ExcelVBA InputBoxによる処理数決定とIFThen Elseif の追加

 はい、懲りずにやっています。

えーーとInputBoxの処理はそんなには時間をかけず、

条件分岐の処理において複数の処理の流れを変えていく作業に時間をかけた。

畑での作業中に処理の展開を考えてそれを実装したわけですが(=^・^=)

それと、、、これ重要なことかもしれないけれこれOneDrive関係のフォルダで処理ができない。解決の糸口を見だすことができなかった。

とりあえず他の所に移して使っています。悪しからず。。。。

Sub S211()

    ans = InputBox("作成数は？")

    Application.DisplayAlerts = False

    If ans > 2 Then

        inp1 = ans - 2

        zse = Range("J9") & "月" & Range("J8") & "日～" & Range("K9") & "月" & Range("K8") & "日"

        ActiveSheet.Name = zse

        ThisWorkbook.Sheets(zse).Copy After:=Sheets(Sheets.Count)

        ActiveSheet.Name = zse & "1"

        Do While i <= inp1

            Range("K11").Select

            Selection.Copy

            Range("B7").PasteSpecial xlPasteValues

            zse = Range("J9") & "月" & Range("J8") & "日～" & Range("K9") & "月" & Range("K8") & "日"

            ActiveSheet.Name = zse

            ThisWorkbook.Sheets(zse).Copy After:=Sheets(Sheets.Count)

            ActiveSheet.Name = zse & "1"

        i = i + 1

        Loop

     ActiveSheet.Delete

    

    

    

    ElseIf ans = 2 Then

        zse = Range("J9") & "月" & Range("J8") & "日～" & Range("K9") & "月" & Range("K8") & "日"

        ActiveSheet.Name = zse

        ThisWorkbook.Sheets(zse).Copy After:=Sheets(Sheets.Count)

        ActiveSheet.Name = zse & "1"

        Range("K11").Select

        Selection.Copy

        Range("B7").PasteSpecial xlPasteValues

        zse = Range("J9") & "月" & Range("J8") & "日～" & Range("K9") & "月" & Range("K8") & "日"

        ActiveSheet.Name = zse

    

    

    ElseIf ans = 1 Then

        zse = Range("J9") & "月" & Range("J8") & "日～" & Range("K9") & "月" & Range("K8") & "日"

        ActiveSheet.Name = zse

    

    Else

        ActiveWorkbook.Close

    

    End If

    

    

    

Dim j As Long

Dim cona As Long

Dim ashna As String

Dim foruda As String

    Dim root As String

    Dim yyyy As String

    Dim mm As String

    Dim fold_pathA As String

    Dim fold_path As String

    Dim fold_pathY As String

    Dim fold_pathM As String

    Dim fold_pathP As String

    Dim fold_pathE As String

    

root = ThisWorkbook.Path

fold_pathA = root & "\勤務予定表\"

   If Dir(fold_pathA, vbDirectory) = "" Then

        MkDir fold_pathA

    End If

cona = Sheets.Count

For j = 1 To cona

Sheets(j).Select

ActiveSheet.Copy

yyyy = Range("J13")

mm = Range("J9")

fold_pathY = fold_pathA & yyyy & "年\"

   If Dir(fold_pathY, vbDirectory) = "" Then

        MkDir fold_pathY

    End If  '年別フォルダー

fold_pathM = fold_pathY & mm & "月\"

   If Dir(fold_pathM, vbDirectory) = "" Then

        MkDir fold_pathM

    End If  '月別フォルダー

fold_pathP = fold_pathM & "02_pdf\"

   If Dir(fold_pathP, vbDirectory) = "" Then

        MkDir fold_pathP

    End If 'PDF用フォルダー

fold_pathE = fold_pathM & "01_Excel\"

   If Dir(fold_pathE, vbDirectory) = "" Then

        MkDir fold_pathE

    End If 'Excel用フォルダー

ashna = ActiveSheet.Name

 

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=fold_pathP & ashna & ".pdf"

        ActiveWorkbook.SaveAs fold_pathE & ashna & ".xlsx"

        ActiveWorkbook.Close

Next

 Application.DisplayAlerts = True

 MsgBox "処理が完了しました" & vbCrLf & "確認してください"

End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーー

以下当日別時間追記

ヾ(ΦωΦ)/コンニチﾜ～♪

そもそも数値入力やIfをつかって分岐処理をしようと考えたのは

初期シートのセルに数値入力してから始めるのが何となく手間であり、せっかくVBA上で

処理が可能なのだからそこで数値入力を施したいというのがふと頭に浮かんだからです。

また、IF処理び分岐についてはほかのことでも同じことをしようとしたときに流用し高いからと感じたからです。

＼(゜ロ＼)(／ロ゜)／
プリント機能は現段階ではA3ファイルの作成を想定して作成しています。

A4サイズでの印刷ファイルについてはどこかしらにデフォルトで印刷するような内容にしますが、どこの段階でそれを実行するかは検討中です。個人的にはエクセル形式でのファイル保存の手前でその処理をするようにすると思いますが、現在は検討の域を出ていません

（（((((O_o;)サササッ

そのほかファイルのある場所に親フォルダとして各種子フォルダ作成等流れにした理由はすぐに参照するのにそこにあったほうがいいと感じたということちょっと内容を変えてもそこの場所を指定しなくて済むよにということです。別にフォルダを変える処理を入れてもいいのですが、とりあえずめんどくさいからいれませんでした。　将来的には入れる予定、それでも処理数入力と同じような感じにすると思います。

ε=(￣｡￣;)ﾌｩ

とりあえずこんな感じです。

ではまた

ヾ(=・ω・=)o☆バイバイ☆ヾ(=・ω・=)o