【システム】請求書作成マクロ(VBA)の公開【添付ファイルあり】

1.請求書作成マクロを公開しました

 特許事務所では、種々のシステムを使って案件の管理や、書類の作成を行っています。案件管理やプロジェクト管理は、一般的な会社でも大規模な独自システムあるいは、安価なERPパッケージを使用して行っていますよね。

 しかしながら、基幹システムには過不足があることはよくあることです。

 弊所では、その過不足を解消するためのサブシステム作りを行っています。そこで、今回は請求書作成マクロをテスト公開してみました。

 ココをクリックしてZIPファイルをダウンロードしてください。

 なお、本マクロはテスト公開仕様のものですので、動作保証やこれの使用で生じた損害等は免責とさせていただければと思います。ご了承ください。

2.請求書作成マクロの仕様

 今回公開する請求書作成マクロ(商標等の年金納付の)は、①.xlsmファイルを起動してその中にあるボタンをクリックする、②.ファイル取り込み用のダイアログが開くので専用のデータベースファイルを取り込む、③.PDFで合計請求書とその明細が出力される、という仕様です。

 xlsmファイルのフォーマットシートを調整することで、出力内容も調整することができます。

 この他にも種々のマクロ(サブシステム)を構築することが可能ですので、興味がある方は弊所までご連絡ください。システム規模に応じて、サブシステムの構築・保守・点検を請け負います。

 なお、請求書は、下記のような表示でPDF出力されます。

【合計請求書・表紙】

【明細】

 

3.モジュールのコード

 以下は、xlsmファイル中のモジュールのコードです。参考までに公開します。

Option Explicit

Public Sub MakeInvoice()

On Error Resume Next

Application.Visible = False

'----------------------------------
'ここからが、ファイルのインポート処理
'ファイル名の取得
Dim TargetDocPath As String

Dim MyPath As String, wsh As Variant
Set wsh = CreateObject("WScript.Shell")
MyPath = wsh.SpecialFolders("Desktop") '& "\"
Set wsh = Nothing
'カレントディレクトリの変更
ChDir ThisWorkbook.Path
'Path
TargetDocPath = Application.GetOpenFilename(FileFilter:="xls-xlsxファイル,*.xls*,CSVファイル,*.csv")

If TargetDocPath = "False" Then
'MsgBox "キャンセルされました"
Application.Visible = True
End
End If
'------------------------------------
'Open用ファイル作成
Application.DisplayAlerts = False '警告を一時無視

'元ファイル開いていてもよいようにコピーファイル生成
Dim TemporaryFilePath2 As String
TemporaryFilePath2 = Replace(TargetDocPath, ".xlsx", "_2_" & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ".xlsx")

'元ファイル開いていてもコピーする
Dim objFSO992 As Object
Set objFSO992 = CreateObject("Scripting.FileSystemObject")
objFSO992.CopyFile TargetDocPath, TemporaryFilePath2
Set objFSO992 = Nothing

'コピーファイルOpen
Dim objExcel As Object
Set objExcel = Application.Workbooks.Open(TemporaryFilePath2)


'------------------------------------
'ファイル情報取得
With objExcel.Worksheets(1)
'-------------------------------
'頭行決定
Dim objExcelFirstRow As Long
objExcelFirstRow = 1
'最終行数取得
Dim objExcelLastRow As Long
objExcelLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'-------------------------------
'頭列決定
Dim objExcelFirstCol As Long
objExcelFirstCol = 1
'最終列数取得
Dim objExcelLastCol As Long
objExcelLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'-------------------------------

'クライアント名称列の取得
Dim TargetClientCol As Integer
If IsError(Application.Match("経費負担先", _
.Range(.Cells(1, 1), _
.Cells(1, objExcelLastCol)), _
0)) Then
'重複行無
MsgBox "クライアント名称格納列が無いため処理を終了します。"
Application.Visible = True
End
Else
'重複行有
TargetClientCol = Application.Match("経費負担先", _
.Range(.Cells(1, 1), _
.Cells(1, objExcelLastCol)), _
0)
End If

'ソート処理(クライアント名称をprimaryとして整列させる)
.Range(.Cells(2, 1), _
.Cells(.Rows.Count, .Columns.Count)).Sort _
Key1:=.Range(Chr(TargetClientCol + 64) & 2), _
Order1:=xlAscending, _
Header:=xlNo

'-------------------------------
'二次元配列処理
Dim strRowCol() As Variant
'再定義
ReDim strRowCol(objExcelLastRow, objExcelLastCol)
'格納用
Dim CRow As Long
Dim CCol As Long
'---------------------------------------------
For CRow = 1 To objExcelLastRow
For CCol = 1 To objExcelLastCol
'二次元配列への格納
strRowCol(CRow, CCol) = .Cells(CRow, CCol)
Next CCol
Next CRow
'---------------------------------------------
'ファイル削除(Log残しのため、通常はコメントアウト)
objExcel.Save
objExcel.Close SaveChanges:=False
Kill TemporaryFilePath2
End With
Set objExcel = Nothing
'------------------------------------
'列名の特定
Dim 対象管理Col As String
Dim 管理番号Col As String
Dim 当所整理番号Col As String
Dim 四法Col As String
Dim 国コードCol As String
Dim 登録番号Col As String
Dim 課目Col As String
Dim 事業分野Col As String
Dim 請求書番号Col As String
Dim 請求日Col As String
Dim 経費負担先Col As String
Dim 支払先Col As String
Dim 納付期限日Col As String
Dim 年度Col As String
Dim 支払金額Col As String
Dim 印紙代Col As String
Dim 手数料Col As String
Dim 消費税Col As String
Dim 負担率Col As String
Dim メモCol As String

For CCol = 1 To objExcelLastCol
Select Case True
Case CStr(strRowCol(1, CCol)) Like "対象管理"
対象管理Col = CCol
Case CStr(strRowCol(1, CCol)) Like "管理番号"
管理番号Col = CCol
Case CStr(strRowCol(1, CCol)) Like "当所整理番号"
当所整理番号Col = CCol
Case CStr(strRowCol(1, CCol)) Like "四法"
四法Col = CCol
Case CStr(strRowCol(1, CCol)) Like "国コード"
国コードCol = CCol
Case CStr(strRowCol(1, CCol)) Like "登録番号"
登録番号Col = CCol
Case CStr(strRowCol(1, CCol)) Like "課目"
課目Col = CCol
Case CStr(strRowCol(1, CCol)) Like "事業分野"
事業分野Col = CCol
Case CStr(strRowCol(1, CCol)) Like "請求書番号"
請求書番号Col = CCol
Case CStr(strRowCol(1, CCol)) Like "請求日"
請求日Col = CCol
Case CStr(strRowCol(1, CCol)) Like "経費負担先"
経費負担先Col = CCol
Case CStr(strRowCol(1, CCol)) Like "支払先*"
支払先Col = CCol
Case CStr(strRowCol(1, CCol)) Like "納付期限日"
納付期限日Col = CCol
Case CStr(strRowCol(1, CCol)) Like "年度"
年度Col = CCol
Case CStr(strRowCol(1, CCol)) Like "支払金額"
支払金額Col = CCol
Case CStr(strRowCol(1, CCol)) Like "印紙代"
印紙代Col = CCol
Case CStr(strRowCol(1, CCol)) Like "手数料"
手数料Col = CCol
Case CStr(strRowCol(1, CCol)) Like "消費税"
消費税Col = CCol
Case CStr(strRowCol(1, CCol)) Like "負担率"
負担率Col = CCol
Case CStr(strRowCol(1, CCol)) Like "メモ"
メモCol = CCol
End Select
Next CCol
'------------------------------------
'メインの処理開始
'●方針
' 「経費負担先(クライアント名称)」はソート済で、この名称が切り替わるまで合算処理を続ける。

'スクリーンの表示
Application.ScreenUpdating = False
'セルのエラーチェックを停止
Application.ErrorCheckingOptions.BackgroundChecking = False

Dim OldClientName As String
OldClientName = ""
Dim NewClientName As String
NewClientName = ""

Dim TargetSh_Main As Object
Dim TargetSh_Sub As Object

Dim Main_クライアント名称 As String
Dim Main_請求年月日 As String
Dim Main_請求書番号 As String
Dim Main_期限年月 As String
Dim Main_現地費用合計 As Long
Dim Main_当所費用合計 As Long
Dim Main_当所費用消費税 As Long
Dim Main_総合計 As Long

Main_現地費用合計 = 0
Main_当所費用合計 = 0
Main_当所費用消費税 = 0
Main_総合計 = 0

Dim Sub_クライアント名称 As String
Dim Sub_請求年月日 As String
Dim Sub_請求書番号 As String
Dim Sub_期限年月 As String
Dim Sub_現地費用合計 As Long
Dim Sub_当所費用合計 As Long
Dim Sub_総合計 As Long

Sub_現地費用合計 = 0
Sub_当所費用合計 = 0
Sub_総合計 = 0

Dim SubShRowCNT As Long
SubShRowCNT = ThisWorkbook.Worksheets("Invoice_Detail_Format").Cells(ThisWorkbook.Worksheets("Invoice_Detail_Format").Rows.Count, 1).End(xlUp).Row

Dim insRange As String
Dim PdfTargetPath As String

For CRow = 2 To objExcelLastRow
'----------------------------------------------------
'フォーム処理
If UserForms.Count = 0 Then
SearchCondition.Show vbModeless
End If

If CRow = objExcelLastRow Then
SearchCondition.Label1.Caption = "進捗状況" & vbTab & vbTab & ": " & CInt(100 * CRow / objExcelLastRow) & "%" & vbCr & _
"全処理が完了しました。"

Else
SearchCondition.Label1.Caption = "進捗状況" & vbTab & vbTab & ": " & CInt(100 * CRow / objExcelLastRow) & "%" & vbCr & _
"処理対象クライアント" & vbTab & ": " & CStr(strRowCol(CRow, 経費負担先Col))
End If
DoEvents
'----------------------------------------------------


NewClientName = CStr(strRowCol(CRow, 経費負担先Col))
'--------------------------------------
If OldClientName = NewClientName Then
'-----------------------------------
'合算処理続行
Main_現地費用合計 = Main_現地費用合計 + CLng(strRowCol(CRow, 印紙代Col))
Main_当所費用合計 = Main_当所費用合計 + CLng(strRowCol(CRow, 手数料Col))
Main_当所費用消費税 = Main_当所費用消費税 + CLng(strRowCol(CRow, 消費税Col))
Main_総合計 = Main_現地費用合計 + _
Main_当所費用合計 + _
Main_当所費用消費税


'Subシート記入処理
With TargetSh_Sub
'行を追加します
SubShRowCNT = SubShRowCNT + 1
insRange = (SubShRowCNT) & ":" & (SubShRowCNT)
.Rows(insRange).Insert
'枠設定
.Range(.Cells(SubShRowCNT, 1), .Cells(SubShRowCNT, 8)).Borders.LineStyle = xlContinuous
'左寄せ
.Range(.Cells(SubShRowCNT, 1), .Cells(SubShRowCNT, 4)).HorizontalAlignment = xlLeft
'右寄せ
.Range(.Cells(SubShRowCNT, 6), .Cells(SubShRowCNT, 8)).HorizontalAlignment = xlRight

'記入
.Cells(SubShRowCNT, 1) = strRowCol(CRow, 管理番号Col)
.Cells(SubShRowCNT, 2) = strRowCol(CRow, 当所整理番号Col)
.Cells(SubShRowCNT, 3) = strRowCol(CRow, 四法Col)
.Cells(SubShRowCNT, 4) = strRowCol(CRow, 国コードCol)
.Cells(SubShRowCNT, 5) = strRowCol(CRow, 年度Col)
.Cells(SubShRowCNT, 6) = strRowCol(CRow, 印紙代Col)
.Cells(SubShRowCNT, 7) = strRowCol(CRow, 手数料Col)
.Cells(SubShRowCNT, 8) = strRowCol(CRow, 印紙代Col) + strRowCol(CRow, 手数料Col)
End With
'Subシート加算処理
Sub_現地費用合計 = Sub_現地費用合計 + CLng(strRowCol(CRow, 印紙代Col))
Sub_当所費用合計 = Sub_当所費用合計 + CLng(strRowCol(CRow, 手数料Col))
Sub_総合計 = Sub_現地費用合計 + _
Sub_当所費用合計
'-----------------------------------
Else
'-----------------------------------
'合算処理終了
'--------------------------------
If OldClientName <> "" Then
'数値入力_Main
With TargetSh_Main
.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【クライアント名称】", _
Replacement:=Main_クライアント名称, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求年月日】", _
Replacement:=Main_請求年月日, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求書番号】", _
Replacement:=Main_請求書番号, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【期限年月】", _
Replacement:=Main_期限年月, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【現地費用合計】", _
Replacement:=Main_現地費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【当所費用合計】", _
Replacement:=Main_当所費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【当所費用消費税】", _
Replacement:=Main_当所費用消費税, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【総合計】", _
Replacement:=Main_総合計, _
LookAt:=xlPart, _
MatchCase:=True
End With


'数値入力_Sub
With TargetSh_Sub
.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【クライアント名称】", _
Replacement:=Sub_クライアント名称, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求年月日】", _
Replacement:=Sub_請求年月日, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求書番号】", _
Replacement:=Sub_請求書番号, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【期限年月】", _
Replacement:=Sub_期限年月, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【現地費用合計】", _
Replacement:=Sub_現地費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【当所費用合計】", _
Replacement:=Sub_当所費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【総合計】", _
Replacement:=Sub_総合計, _
LookAt:=xlPart, _
MatchCase:=True
End With


'変数初期化処理
Main_現地費用合計 = 0
Main_当所費用合計 = 0
Main_当所費用消費税 = 0
Main_総合計 = 0

Sub_現地費用合計 = 0
Sub_当所費用合計 = 0
Sub_総合計 = 0

SubShRowCNT = ThisWorkbook.Worksheets("Invoice_Detail_Format").Cells(ThisWorkbook.Worksheets("Invoice_Detail_Format").Rows.Count, 1).End(xlUp).Row


PdfTargetPath = ThisWorkbook.Path & "\" & TargetSh_Main.Name & ".pdf"
ThisWorkbook.Worksheets(Array(TargetSh_Main.Name, TargetSh_Sub.Name)).Select
ThisWorkbook.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfTargetPath

'グループ化解除
ThisWorkbook.Worksheets(1).Select

'対象シート削除
Application.DisplayAlerts = False ' メッセージを非表示
TargetSh_Main.Delete
TargetSh_Sub.Delete
Application.DisplayAlerts = True ' メッセージを表示

End If
'--------------------------------

'最後尾シート作成
ThisWorkbook.Worksheets("Invoice_Main_Format").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set TargetSh_Main = ActiveSheet
TargetSh_Main.Name = NewClientName & "請求書"
ThisWorkbook.Worksheets("Invoice_Detail_Format").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set TargetSh_Sub = ActiveSheet
TargetSh_Sub.Name = NewClientName & "明細"
'クライアント名称
Main_クライアント名称 = NewClientName
Sub_クライアント名称 = NewClientName

'請求年月日
Main_請求年月日 = Year(CDate(strRowCol(CRow, 請求日Col))) & "年" & _
Month(CDate(strRowCol(CRow, 請求日Col))) & "月" & _
Day(CDate(strRowCol(CRow, 請求日Col))) & "日"
Sub_請求年月日 = Year(CDate(strRowCol(CRow, 請求日Col))) & "年" & _
Month(CDate(strRowCol(CRow, 請求日Col))) & "月" & _
Day(CDate(strRowCol(CRow, 請求日Col))) & "日"

'請求書番号
Main_請求書番号 = strRowCol(CRow, 請求書番号Col)
Sub_請求書番号 = strRowCol(CRow, 請求書番号Col)

'期限年月
Main_期限年月 = Year(CDate(strRowCol(CRow, 納付期限日Col))) & "年" & _
Month(CDate(strRowCol(CRow, 納付期限日Col))) & "月"
Sub_期限年月 = Main_期限年月

'加算開始
Main_現地費用合計 = CLng(strRowCol(CRow, 印紙代Col))
Main_当所費用合計 = CLng(strRowCol(CRow, 手数料Col))
Main_当所費用消費税 = CLng(strRowCol(CRow, 消費税Col))
Main_総合計 = Main_現地費用合計 + _
Main_当所費用合計 + _
Main_当所費用消費税

'Subシート記入処理
With TargetSh_Sub
'行を追加します
SubShRowCNT = SubShRowCNT + 1
insRange = (SubShRowCNT) & ":" & (SubShRowCNT)
.Rows(insRange).Insert
'枠設定
.Range(.Cells(SubShRowCNT, 1), .Cells(SubShRowCNT, 8)).Borders.LineStyle = xlContinuous
'左寄せ
.Range(.Cells(SubShRowCNT, 1), .Cells(SubShRowCNT, 4)).HorizontalAlignment = xlLeft
'右寄せ
.Range(.Cells(SubShRowCNT, 6), .Cells(SubShRowCNT, 8)).HorizontalAlignment = xlRight
'記入
.Cells(SubShRowCNT, 1) = strRowCol(CRow, 管理番号Col)
.Cells(SubShRowCNT, 2) = strRowCol(CRow, 当所整理番号Col)
.Cells(SubShRowCNT, 3) = strRowCol(CRow, 四法Col)
.Cells(SubShRowCNT, 4) = strRowCol(CRow, 国コードCol)
.Cells(SubShRowCNT, 5) = strRowCol(CRow, 年度Col)
.Cells(SubShRowCNT, 6) = strRowCol(CRow, 印紙代Col)
.Cells(SubShRowCNT, 7) = strRowCol(CRow, 手数料Col)
.Cells(SubShRowCNT, 8) = strRowCol(CRow, 印紙代Col) + strRowCol(CRow, 手数料Col)

End With

'Subシート加算処理
Sub_現地費用合計 = CLng(strRowCol(CRow, 印紙代Col))
Sub_当所費用合計 = CLng(strRowCol(CRow, 手数料Col))
Sub_総合計 = Sub_現地費用合計 + _
Sub_当所費用合計
'-----------------------------------
End If
'--------------------------------------
OldClientName = NewClientName


'--------------------------------------
'終了処理
If CRow = objExcelLastRow Then

'ここに終了処理コピペ(最後の入力とかpdf生成とか)
'数値入力_Main
With TargetSh_Main
.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【クライアント名称】", _
Replacement:=Main_クライアント名称, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求年月日】", _
Replacement:=Main_請求年月日, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求書番号】", _
Replacement:=Main_請求書番号, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【期限年月】", _
Replacement:=Main_期限年月, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【現地費用合計】", _
Replacement:=Main_現地費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【当所費用合計】", _
Replacement:=Main_当所費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【当所費用消費税】", _
Replacement:=Main_当所費用消費税, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【総合計】", _
Replacement:=Main_総合計, _
LookAt:=xlPart, _
MatchCase:=True
End With


'数値入力_Sub
With TargetSh_Sub
.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【クライアント名称】", _
Replacement:=Sub_クライアント名称, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求年月日】", _
Replacement:=Sub_請求年月日, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【請求書番号】", _
Replacement:=Sub_請求書番号, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(50, 20)).Replace What:="【期限年月】", _
Replacement:=Sub_期限年月, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【現地費用合計】", _
Replacement:=Sub_現地費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【当所費用合計】", _
Replacement:=Sub_当所費用合計, _
LookAt:=xlPart, _
MatchCase:=True

.Range(.Cells(1, 1), .Cells(SubShRowCNT + 1, 20)).Replace What:="【総合計】", _
Replacement:=Sub_総合計, _
LookAt:=xlPart, _
MatchCase:=True
End With


'変数初期化処理
Main_現地費用合計 = 0
Main_当所費用合計 = 0
Main_当所費用消費税 = 0
Main_総合計 = 0

Sub_現地費用合計 = 0
Sub_当所費用合計 = 0
Sub_総合計 = 0

SubShRowCNT = ThisWorkbook.Worksheets("Invoice_Detail_Format").Cells(ThisWorkbook.Worksheets("Invoice_Detail_Format").Rows.Count, 1).End(xlUp).Row


PdfTargetPath = ThisWorkbook.Path & "\" & TargetSh_Main.Name & ".pdf"
ThisWorkbook.Worksheets(Array(TargetSh_Main.Name, TargetSh_Sub.Name)).Select
ThisWorkbook.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfTargetPath
'グループ化解除
ThisWorkbook.Worksheets(1).Select


'対象シート削除
Application.DisplayAlerts = False ' メッセージを非表示
TargetSh_Main.Delete
TargetSh_Sub.Delete
Application.DisplayAlerts = True ' メッセージを表示
End If
'--------------------------------------

Next CRow

'フォルダ開く
Dim targ As String
targ = ThisWorkbook.Path
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus

ThisWorkbook.Worksheets(1).Name = "仕様"

'スクリーンの表示再開
Application.ScreenUpdating = True
'セルのエラーチェックを再開
Application.ErrorCheckingOptions.BackgroundChecking = True
'------------------------------------

'警告回復
Application.DisplayAlerts = True '警告を一時無視

If UserForms.Count <> 0 Then
Unload SearchCondition
End If

'再表示
'Application.Windows(ThisWorkbook.Name).Visible = True
Application.Visible = True

End Sub

この投稿へのコメント

コメントはありません。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA


この投稿へのトラックバック

トラックバックはありません。

トラックバック URL