0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

印刷マクロ

Posted at

Private Const CODE1 As String = "TS"
Private Const CODE2 As String = "TE"
Private Const PDFPATH As String = "C:¥test¥"

Private Sub CommandButton4_Click()
Dim i As Integer

For i = ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(i) Then
        ListBox1.RemoveItem (i)
        Exit For
    End If
Next i

End Sub

Private Sub CommandButton5_Click()
Dim objWShell As Object
Set objWShell = CreateObject("WScript.Shell")

For i = 0 To ListBox1.ListCount - 1
    objWShell.exec ("C:¥Program Files¥Adobe¥Reader 11.0¥Reader¥AcroRd32.exe /n /s /o /h /t " & PDFPATH & ListBox1.List(i))

    Application.Wait Now + TimeValue("00:00:04")
Next

End Sub

Private Sub UserForm_Initialize()
Dim i As Integer 'カウンタ
Dim n As Integer 'カウンタ
Dim wkFileName As String 'pdfファイル名(一時用)
Dim pdf() As pdfFileInfo 'pdf情報

TextBox3.Value = DateAdd("h", -1, Now)
TextBox3.Value = Format(TextBox3.Value, "yyyy/m/d hh:nn")

i = 0                               'PDFディレクトリ用カウンタの初期化
wkFileName = Dir(PDFPATH & "*.pdf")
Do While wkFileName <> ""
    ReDim Preserve pdf(i)
    If FilteringFile(wkFileName) Then
        pdf(i).realName = wkFileName
        pdf(i).timeStamp = FileDateTime(PDFPATH & wkFileName)
    End If
    wkFileName = Dir()
    i = i + 1
Loop

Call BubbleSort1(pdf)
n = 0
For i = 0 To UBound(pdf)
    If pdf(i).realName <> "" Then
        ListBox1.AddItem ""
        ListBox1.List(n, 0) = pdf(i).realName
        ListBox1.List(n, 1) = pdf(i).timeStamp
        n = n + 1
    End If
Next

End Sub
Private Sub CommandButton3_Click()
Dim i As Integer 'カウンタ
Dim n As Integer 'カウンタ
Dim wkFileName As String 'pdfファイル名(一時用)
Dim pdf() As pdfFileInfo 'pdf情報

ListBox1.Clear
i = 0                               'PDFディレクトリ用カウンタの初期化
wkFileName = Dir(PDFPATH)
Do While wkFileName <> ""
    ReDim Preserve pdf(i)
    If FilteringFile(wkFileName) Then
        pdf(i).realName = wkFileName
        pdf(i).timeStamp = FileDateTime(PDFPATH & wkFileName)
    End If
    wkFileName = Dir()
    i = i + 1
Loop

Call BubbleSort1(pdf)

ListBox1.Clear
n = 0
For i = 0 To UBound(pdf)
    If pdf(i).realName <> "" Then
        ListBox1.AddItem
        ListBox1.List(n, 0) = pdf(i).realName
        ListBox1.List(n, 1) = pdf(i).timeStamp
        n = n + 1
    End If
Next

End Sub

Private Function FilteringFile(arg As String) As Boolean
Dim wkSptString() As String
Dim wkOrderNum As Long
Dim wkTxtBox1 As String
Dim wkTxtBox2 As String
Dim wkDateTime As Date

'ファイル名にTSが含まれるかどうかチェック
If CheckBox1.Value = True And CheckBox2.Value = False And InStr(arg, CODE1) = 0 Then
    FilteringFile = False
    Exit Function
End If

'ファイル名にTEが含まれるかどうかチェック
If CheckBox1.Value = False And CheckBox2.Value = True And InStr(arg, CODE2) = 0 Then
    FilteringFile = False
    Exit Function
End If

'ファイル名にTSとTEが含まれるかどうかチェック
If CheckBox1.Value = True And CheckBox2.Value = True And InStr(arg, CODE1) = 0 And InStr(arg, CODE2) = 0 Then
    FilteringFile = False
    Exit Function
End If

'ファイル名からオーダ番号を抽出
wkSptString = Split(arg, "-")
wkOrderNum = Val(Mid(wkSptString(2), 3, 7))

'TextBox1が入力済みでTextBox2が未入力
If TextBox1.Value <> "" And TextBox2.Value = "" Then
    wkTxtBox1 = Mid(TextBox1.Value, 3, 7)

    If Val(wkTxtBox1) > wkOrderNum Then
        FilteringFile = False
        Exit Function
    End If
End If

'TextBox1とTextBox2が入力済み
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
    wkTxtBox1 = Mid(TextBox1.Value, 3, 7)
    wkTxtBox2 = Mid(TextBox2.Value, 3, 7)
    
    'カレントオーダ番号がTextBox1より小さい場合
    If wkOrderNum < Val(wkTxtBox1) Then
        'Falseを返して終了
        FilteringFile = False
        Exit Function
    End If
    'カレントオーダ番号がTextBox2より大きい場合
    If wkOrderNum > Val(wkTxtBox2) Then
        FilteringFile = False
        Exit Function
    End If
End If

'TextBox3が入力済み
If TextBox3.Value <> "" Then
    wkDateTime = FileDateTime(PDFPATH & arg)
    'PDFのタイムスタンプがTextBox3の日付より若い場合
    If TextBox3.Value > wkDateTime Then
        FilteringFile = False
        Exit Function
    End If
End If

FilteringFile = True

End Function

Private Sub CommandButton1_Click()
Dim n As Long
Dim buf As String

n = ListBox1.ListIndex        '(1)現在選択されている位置を記憶する
If n = 0 Then Exit Sub        '選択されているのが最上部なら終了
pdf = ListBox1.List(n)        '(2)現在選択されているデータを記憶する
ListBox1.RemoveItem n         '(3)現在選択されている位置のデータを削除する
ListBox1.AddItem pdf, n - 1   '(4)1つ上の位置にデータを追加する
ListBox1.ListIndex = n - 1    '挿入したデータを選択する

End Sub

Private Sub CommandButton2_Click()
Dim n As Long, buf As String
n = ListBox1.ListIndex
If n = ListBox1.ListCount - 1 Then Exit Sub
buf = ListBox1.List(n)
ListBox1.RemoveItem n
ListBox1.AddItem buf, n + 1
ListBox1.ListIndex = n + 1
End Sub

Private Sub BubbleSort1(ByRef argAry() As pdfFileInfo)

Dim vSwap As pdfFileInfo
Dim i As Integer
Dim j As Integer

For i = LBound(argAry) To UBound(argAry)
    For j = UBound(argAry) To i Step -1
        If argAry(i).timeStamp > argAry(j).timeStamp Then
            vSwap = argAry(i)
            argAry(i) = argAry(j)
            argAry(j) = vSwap
        End If
    Next j
Next i

End Sub

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?