実行中以外の
ブック名 と パス と フルネーム
を取得する。
後ほどブックを操作するために、
実行中のエクセルにフルパスを記憶させる場合に用いると便利。
＜サンプル＞
Dim myBookName As Workbook
For Each myBookName In Workbooks
If myBookName.Name <> ThisWorkbook.Name Then
'実行中のブック名以外の・・・
'1：ブック名を出力する
Debug.Print myBookName.Name
'2；パスを出力する
Debug.Print myBookName.Path
'3；フルネームを出力する
Debug.Print myBookName.FullName
End If
Next myBookName
ファイルを呼び出して処理する前に、
次のようなコードで存在するかを確認する方がよい。
Dir(****ｱﾄﾞﾚｽ*****)
⇒ ファイルが存在しないなら 空白 になる
⇒ ファイルが存在するなら ファイル名 を取得する
<サンプル>
dim myAdress as string
myAdress = "" ←フルパスを記入
If Dir(myAdress) = "" Then
'指定したディレクトリがない場合
else
'指定したディレクトリがある場合
End If
次のようなコードで存在するかを確認する方がよい。
Dir(****ｱﾄﾞﾚｽ*****)
⇒ ファイルが存在しないなら 空白 になる
⇒ ファイルが存在するなら ファイル名 を取得する
<サンプル>
dim myAdress as string
myAdress = "" ←フルパスを記入
If Dir(myAdress) = "" Then
'指定したディレクトリがない場合
else
'指定したディレクトリがある場合
End If
エクセルの表で入力する文字を管理し、
文字の置換を用いて定型文を作成する。
印刷後は別名で保存する。
表の例（あらかじめ規則にのっとり表を作成している）
文書の例（文字置換となるタグを用いている）
ワードのオブジェクトを明示しないと二回目の処理でエラーが出るので注意すること！
（この例では wdObj で明示している）
＜サンプル＞
Dim wdObj As Object 'オブジェクト（ワードブック）
Dim i As Long, x As Long
Dim myBef As String '変換前
Dim myAft As String '変換後
Dim myTotal As Long '期間中の合計金額
Const kaku As String = ".doc" '拡張子
Const startCol As Long = 5 '5列目から処理を開始する
Const befYear As Long = 5 '過去五年までさかのぼる
Sub 文字を置換して印刷し保存する()
'事前に・・・
'①[参照設定]で「Microsoft Word 11.0 Object Library」をチェックします。
'verは変更になっていることもあるので、
'それらしい物を探してみましょう。
'②wordで作成した文書を保管しておきます。
'ここで例として使用したタグは
'《本年》 《一年前》 《一年前の金額》 《合計金額》
'などです
'～～～変数の宣言
Dim myAdress As String 'ｱﾄﾞﾚｽとファイル名を格納
Dim mySury As Long '数量が書かれた列数
'↓↓↓ここから↓↓↓ScreenUpdatingをfalseにしていると処理できないので注意する
Application.ScreenUpdating = True
'～～～入力開始
i = 3 'データは三行目から記されている
Do While Cells(i, "B").Value <> ""
Call main処理
'次の行へ
i = i + 1
Loop
' Application.ScreenUpdating = True
' Application.ScreenUpdating = False
'↑↑↑ここまで↑↑↑ScreenUpdatingをfalseにしていると処理できないので注意する
End Sub
Private Sub main処理()
'！！！ワードの操作を開始！！！
'指定したディレクトリがあるか確認する
myAdress = Cells(i, "C").Value & "\" & Cells(i, "D").Value
If Dir(myAdress) = "" Then
'指定したディレクトリがない → ファイル名を記したセルを赤色にする
Cells(i, "D").Interir.Color = vbRed
GoTo ex
End If
If Cells(i, "A").Value <> "" Then
'変数の宣言
Set wdObj = CreateObject("word.Application")
Dim wordFile As String
'合計金額の変数を0にします
myTotal = 0
'オープンするワードのファイル名をパス名付きで入れます
wordFile = myAdress '& kaku
'1：ワードを開きます
With wdObj
.Visible = True
.Documents.Open wordFile
End With
'2：書き込み
'2-0：ループなしで置換する
myBef = "《本年》" '年を指している部分を探す
myAft = Format(Date, "ggge年m月d日") '和暦
Call 置換開始
'2-1：befYear年分さかのぼって置換（合計金額なし）
For x = startCol To startCol + befYear - 1
'～～～年
myBef = "《" & Cells(2, x).Value & "》" '年を指している部分を探す
myAft = Format(DateAdd("yyyy", -x + befYear - 1, Date), "ggge年") '和暦
Call 置換開始
'～～～数量
'数量は特に合計を求めない
mySury = x + befYear '数量が記された列数
myBef = "《" & Cells(2, mySury).Value & "の数量》" '数量を指している部分を探す
myAft = Format(Cells(i, mySury).Value, "#,##0")
Call 置換開始
Next x
'2-2：befYear年分さかのぼって置換（合計金額あり）
For x = startCol To startCol + befYear
'～～～金額
myBef = "《" & Cells(2, x).Value & "の金額》" '金額を指している部分を探す
myAft = Format(Cells(i, x).Value, "\\#,##0")
Call 置換開始_合計込
Next x
'3：合計金額を入力する
If myTotal >= 1 Then
'合計金額入力
myBef = "《合計金額》" '合計金額を指している部分を探す
myAft = Format(myTotal, "\\#,##0") '集計結果
Call 置換開始_合計込
Else
'金額がないので空白を入力する
myBef = "《合計金額》" '合計金額を指している部分を探す
myAft = "" '←空白
Call 置換開始
End If
'4:プリントアウト
ActiveDocument.PrintOut
'5:別名で保存
wdObj.ActiveDocument.SaveAs Filename:=Cells(i, "C").Value & "\" & Cells(i, "B").Value & Year(Date) & kaku
'6:ワードを閉じます
wdObj.Quit
End If
'wdObjの制御を破棄
Set wdObj = Nothing
’処理がファイルがない場合はココに飛ぶ
ex:
End Sub
Private Sub 置換開始()
With wdObj.ActiveDocument.Content.Find
.Text = myBef
.Format = True '検索・置換をする
If .Execute Then
'myBefが見つかった場合の処理
With .Replacement
.Text = myAft
End With
.Execute Replace:=wdReplaceAll
End If
End With
End Sub
Private Sub 置換開始_合計込()
With wdObj.ActiveDocument.Content.Find
.Text = myBef
.Format = True '検索・置換をする
If .Execute Then
'myBefが見つかった場合の処理
With .Replacement
.Text = myAft
End With
.Execute Replace:=wdReplaceAll
'合計金額算出
myTotal = myTotal + Cells(i, x).Value
End If
End With
End Sub
文字の置換を用いて定型文を作成する。
印刷後は別名で保存する。
表の例（あらかじめ規則にのっとり表を作成している）
文書の例（文字置換となるタグを用いている）
ワードのオブジェクトを明示しないと二回目の処理でエラーが出るので注意すること！
（この例では wdObj で明示している）
＜サンプル＞
Dim wdObj As Object 'オブジェクト（ワードブック）
Dim i As Long, x As Long
Dim myBef As String '変換前
Dim myAft As String '変換後
Dim myTotal As Long '期間中の合計金額
Const kaku As String = ".doc" '拡張子
Const startCol As Long = 5 '5列目から処理を開始する
Const befYear As Long = 5 '過去五年までさかのぼる
Sub 文字を置換して印刷し保存する()
'事前に・・・
'①[参照設定]で「Microsoft Word 11.0 Object Library」をチェックします。
'verは変更になっていることもあるので、
'それらしい物を探してみましょう。
'②wordで作成した文書を保管しておきます。
'ここで例として使用したタグは
'《本年》 《一年前》 《一年前の金額》 《合計金額》
'などです
'～～～変数の宣言
Dim myAdress As String 'ｱﾄﾞﾚｽとファイル名を格納
Dim mySury As Long '数量が書かれた列数
'↓↓↓ここから↓↓↓ScreenUpdatingをfalseにしていると処理できないので注意する
Application.ScreenUpdating = True
'～～～入力開始
i = 3 'データは三行目から記されている
Do While Cells(i, "B").Value <> ""
Call main処理
'次の行へ
i = i + 1
Loop
' Application.ScreenUpdating = True
' Application.ScreenUpdating = False
'↑↑↑ここまで↑↑↑ScreenUpdatingをfalseにしていると処理できないので注意する
End Sub
Private Sub main処理()
'！！！ワードの操作を開始！！！
'指定したディレクトリがあるか確認する
myAdress = Cells(i, "C").Value & "\" & Cells(i, "D").Value
If Dir(myAdress) = "" Then
'指定したディレクトリがない → ファイル名を記したセルを赤色にする
Cells(i, "D").Interir.Color = vbRed
GoTo ex
End If
If Cells(i, "A").Value <> "" Then
'変数の宣言
Set wdObj = CreateObject("word.Application")
Dim wordFile As String
'合計金額の変数を0にします
myTotal = 0
'オープンするワードのファイル名をパス名付きで入れます
wordFile = myAdress '& kaku
'1：ワードを開きます
With wdObj
.Visible = True
.Documents.Open wordFile
End With
'2：書き込み
'2-0：ループなしで置換する
myBef = "《本年》" '年を指している部分を探す
myAft = Format(Date, "ggge年m月d日") '和暦
Call 置換開始
'2-1：befYear年分さかのぼって置換（合計金額なし）
For x = startCol To startCol + befYear - 1
'～～～年
myBef = "《" & Cells(2, x).Value & "》" '年を指している部分を探す
myAft = Format(DateAdd("yyyy", -x + befYear - 1, Date), "ggge年") '和暦
Call 置換開始
'～～～数量
'数量は特に合計を求めない
mySury = x + befYear '数量が記された列数
myBef = "《" & Cells(2, mySury).Value & "の数量》" '数量を指している部分を探す
myAft = Format(Cells(i, mySury).Value, "#,##0")
Call 置換開始
Next x
'2-2：befYear年分さかのぼって置換（合計金額あり）
For x = startCol To startCol + befYear
'～～～金額
myBef = "《" & Cells(2, x).Value & "の金額》" '金額を指している部分を探す
myAft = Format(Cells(i, x).Value, "\\#,##0")
Call 置換開始_合計込
Next x
'3：合計金額を入力する
If myTotal >= 1 Then
'合計金額入力
myBef = "《合計金額》" '合計金額を指している部分を探す
myAft = Format(myTotal, "\\#,##0") '集計結果
Call 置換開始_合計込
Else
'金額がないので空白を入力する
myBef = "《合計金額》" '合計金額を指している部分を探す
myAft = "" '←空白
Call 置換開始
End If
'4:プリントアウト
ActiveDocument.PrintOut
'5:別名で保存
wdObj.ActiveDocument.SaveAs Filename:=Cells(i, "C").Value & "\" & Cells(i, "B").Value & Year(Date) & kaku
'6:ワードを閉じます
wdObj.Quit
End If
'wdObjの制御を破棄
Set wdObj = Nothing
’処理がファイルがない場合はココに飛ぶ
ex:
End Sub
Private Sub 置換開始()
With wdObj.ActiveDocument.Content.Find
.Text = myBef
.Format = True '検索・置換をする
If .Execute Then
'myBefが見つかった場合の処理
With .Replacement
.Text = myAft
End With
.Execute Replace:=wdReplaceAll
End If
End With
End Sub
Private Sub 置換開始_合計込()
With wdObj.ActiveDocument.Content.Find
.Text = myBef
.Format = True '検索・置換をする
If .Execute Then
'myBefが見つかった場合の処理
With .Replacement
.Text = myAft
End With
.Execute Replace:=wdReplaceAll
'合計金額算出
myTotal = myTotal + Cells(i, x).Value
End If
End With
End Sub
'事前に[参照設定]で「Microsoft Word 11.0 Object Library」をチェックします。
'verは変更になっていることもあるので、
'それらしい物を探してみましょう。
'変数の宣言
Dim wdObj As New Word.Application
Dim wdDoc As Word.Document
Dim wordFile As String
'操作するワードのファイル名をパス名付きで設定します
wordFile = "C:\Documents and Settings******pathを入れる*******\test word.doc"
'ワードを開きます
wdObj.Visible = True
wdObj.Documents.Open wordFile
'入力開始
wdObj.Selection.TypeText Text:="てすと"
'ワードを閉じます
wdObj.Quit
'verは変更になっていることもあるので、
'それらしい物を探してみましょう。
'変数の宣言
Dim wdObj As New Word.Application
Dim wdDoc As Word.Document
Dim wordFile As String
'操作するワードのファイル名をパス名付きで設定します
wordFile = "C:\Documents and Settings******pathを入れる*******\test word.doc"
'ワードを開きます
wdObj.Visible = True
wdObj.Documents.Open wordFile
'入力開始
wdObj.Selection.TypeText Text:="てすと"
'ワードを閉じます
wdObj.Quit
With ActiveDocument.Content.Find
.Text = (Year(Date) - 1) & "年" '西暦で昨年を指している部分を探す
.Format = True '検索・置換をする
With .Replacement
.Text = Format(Date, "ggge年") '和暦
.Font.Bold = True '太字にします
End With
.Execute Replace:=wdReplaceAll
End With
.Text = (Year(Date) - 1) & "年" '西暦で昨年を指している部分を探す
.Format = True '検索・置換をする
With .Replacement
.Text = Format(Date, "ggge年") '和暦
.Font.Bold = True '太字にします
End With
.Execute Replace:=wdReplaceAll
End With
'5番目の単語が含まれている段落を均等割り付けにする
ActiveDocument.Words(5).ParagraphFormat.Alignment = wdAlignParagraphDistribute
'中央寄せ → wdAlignParagraphCenter
'左寄せ → wdAlignParagraphLeft
'右寄せ → wdAlignParagraphRight
'均等割り付け → wdAlignParagraphDistribute
ActiveDocument.Words(5).ParagraphFormat.Alignment = wdAlignParagraphDistribute
'中央寄せ → wdAlignParagraphCenter
'左寄せ → wdAlignParagraphLeft
'右寄せ → wdAlignParagraphRight
'均等割り付け → wdAlignParagraphDistribute
Selection.Paragraphs.Alignment = wdAlignParagraphDistribute
'中央寄せ → wdAlignParagraphCenter
'左寄せ → wdAlignParagraphLeft
'右寄せ → wdAlignParagraphRight
'均等割り付け → wdAlignParagraphDistribute
'中央寄せ → wdAlignParagraphCenter
'左寄せ → wdAlignParagraphLeft
'右寄せ → wdAlignParagraphRight
'均等割り付け → wdAlignParagraphDistribute
With ActiveDocument
.Words(2).Copy '２つ目の単語をコピーする
.Range(Start:=5, End:=5).Paste '五文字目にコピーする
End With
'ｺﾋﾟｰ → Copy
'切り取り → Cut
.Words(2).Copy '２つ目の単語をコピーする
.Range(Start:=5, End:=5).Paste '五文字目にコピーする
End With
'ｺﾋﾟｰ → Copy
'切り取り → Cut
ActiveDocument.Sentences(3).Text = "あああああ" '3つ目の文章を入れ替える
ActiveDocument.Words(2).Text = "山田" '二つ目の単語を入れ替える