在職証明のVBAマクロに本日の日付を記載したい

在職証明のマクロで
①　日付の位置を矢印の位置にずらしたい（画像赤丸の位置から矢印の先に位置変更）
②　本日の日付に”年”が2つあるので削除したいです。

今のプログラムはこちらなのですがどうしたら良いかご教示いただけませんでしょうか？

ここに実現したいことを箇条書きで書いてください。

在職証明の本日の日付を一番下の位置から規定の位置に記載できるようにしたい
その際大本の文字は削除したい
イメージ説明

該当のソースコード
Private Sub ToggleButton1_Click()
Dim wordApp As Object
Dim wordDoc As Object

' Wordアプリケーションを起動する
Set wordApp = CreateObject("Word.Application")

' 既存のWordファイルを開く
Set wordDoc = wordApp.Documents.Open("C:\Users\boy_a\Downloads\zaishoku.docx")

' Word文書の最後にカーソルを移動
wordApp.Selection.EndKey Unit:=wdStory

' テキストボックスの値を取得
Dim zipCode As String
zipCode = TextBox1.Value
Dim address As String
address = TextBox2.Value
Dim name As String
name = TextBox3.Value
Dim birth As String
birth = TextBox4.Value
Dim shokui As String
name = TextBox6.Value

' WordTableの操作を追加する
Dim WordTable As Object
Set WordTable = wordDoc.Tables(1)

With WordTable.Cell(1, 2).Range
.MoveEnd wdCharacter, -1
.InsertAfter Me.TextBox2.Value
End With

With WordTable.Cell(2, 2).Range
.MoveEnd wdCharacter, -1
.InsertAfter Me.TextBox3.Value
End With

With WordTable.Cell(3, 2).Range
.MoveEnd wdCharacter, -1
.InsertAfter Me.TextBox4.Value
End With

With WordTable.Cell(4, 2).Range
.MoveEnd wdCharacter, -1
.InsertAfter Me.TextBox6.Value
End With

Set WordTable = Nothing

' 本日の日付を取得
Dim currentDate As Date
currentDate = Date

' 令和の年号と年数を取得
Dim warekiYear As Integer
Dim warekiEra As String
warekiYear = Year(currentDate) - 2018 ' 令和元年が2019年なので、年数から2018を引く

If warekiYear = 1 Then
warekiEra = "令和元年"
Else
warekiEra = "令和" & warekiYear & "年"
End If

' 指定した位置に令和の日付を挿入（年の部分を削除）
Dim modifiedDate As String
modifiedDate = warekiEra & Replace(Format(currentDate, "年mm月dd日"), Year(currentDate) & "年", "")

' Wordドキュメントの一番下の行に移動
wordApp.Selection.EndKey 6
wordApp.Selection.MoveDown 5, 1

' 令和の日付を挿入
wordApp.Selection.TypeText modifiedDate

' Wordの文書を保存して閉じる
wordDoc.Save
wordDoc.Close

' Wordアプリケーションを終了する
wordApp.Quit

' オブジェクトを解放する
Set wordDoc = Nothing
Set wordApp = Nothing
End Sub

追記分

ご教示いただきました様に修正しましたがコンテンツコントロールに記載ができません。

下記のようなプログラムを書きエラーは出ていませんが記載がされません。

Private Sub ToggleButton3_Click()

Dim strTemplateDocumentPath As String
Dim dtToday As Date

strTemplateDocumentPath = "C:\Users\boy_a\Downloads\zaishoku.docx"

If Dir(strTemplateDocumentPath) = "" Then
MsgBox "在職証明書のWordテンプレート文書""" & strTemplateDocumentPath & """が見つかりません！", _
vbCritical, _
"ファイル参照エラー"
Exit Sub
End If

If MsgBox("在職証明書の作成を開始しますか？", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"実行確認") = vbNo Then
Exit Sub
End If

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
On Error GoTo 0
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordApp.Visible = True

Set WordDoc = WordApp.Documents.Open(strTemplateDocumentPath)

dtToday = Date

Dim WordContentControl As Word.ContentControl

For Each WordContentControl In WordDoc.ContentControls
Select Case WordContentControl.Title
Case "発行年月日"
WordContentControl.Range.Text = Format(Date, "yyyy年MM月dd日")
Case Else
'何もしない
End Select
Next
End Sub

meg_

2023/05/01 08:51

１．コードが見にくいのでインデントを付けてください。（「コードの挿入」で記入してください。）２．画像を添付しようとしているようですが表示されていません。投稿前にプレビューで確認できるかと思いますので修正しましょう。

退会済みユーザー

2023/05/01 09:00

megさん　ご指摘いただきありがとうございます。修正致しました。

sk.exe

2023/05/02 01:31

> 本日の日付を挿入する > 狙った位置に書くそういった場合はあらかじめWord文書上にコンテンツコントロール（今回のケースなら日付選択コンテンツコントロール）を配置しておくか、文書変数を定義しておいてフィールドコードによってその値を文書上に表示するようにしておく方が、より構造的なコードを記述しやすくなるでしょう。

1T2R3M4

2023/05/09 06:50

https://qiita.com/19850708/questions/7874c2057a234f6bb6ab 以下ご対応ください。 https://teratail.com/help#posted-otherservice

退会済みユーザー

2023/05/09 07:03

ご指摘いただきありがとうございます。削除致しました。

行動規範の内容に同意します

回答1件

ベストアンサー

テンプレート用Word文書へのコンテンツコントロールの挿入

在職証明書の発行年月日を印字したい位置にカーソルを移動する。
[開発]タブ → [コントロール]グループ → [日付選択コンテンツコントロール]をクリックする。

日付選択コンテンツコントロールのプロパティ設定

日付選択コンテンツコントロールにカーソルを移動する。
[開発]タブ → [コントロール]グループ → [プロパティ]をクリックし、[コンテンツコントロールのプロパティ]ダイアログを開く。
[タイトル]や[日付の表示形式]などのプロパティを適宜設定する。

以上の設定を行った状態で、そのWord文書を保存して閉じる。

日付選択コンテンツコントロールへの値の代入を行なうサンプルマクロ

vba
1Sub CreateCertificateOfEmployment()
2
3    Dim strTemplateDocumentPath As String
4    
5    strTemplateDocumentPath = "C:\FolderName\TemplateFileName.docx"
6    
7    If Dir(strTemplateDocumentPath) = "" Then
8        MsgBox "在職証明書のWordテンプレート文書""" & strTemplateDocumentPath & """が見つかりません！", _
9               vbCritical, _
10               "ファイル参照エラー"
11        Exit Sub
12    End If
13
14    If MsgBox("在職証明書の作成を開始しますか？", _
15              vbQuestion + vbYesNo + vbDefaultButton2, _
16              "実行確認") = vbNo Then
17        Exit Sub
18    End If
19
20    Dim WordApp As Word.Application
21    Dim WordDoc As Word.Document
22    
23    On Error Resume Next
24    Set WordApp = GetObject(, "Word.Application")
25    If Err.Number <> 0 Then
26        Err.Clear
27        On Error GoTo 0
28        Set WordApp = CreateObject("Word.Application")
29    End If
30    On Error GoTo 0
31    WordApp.Visible = True
32    
33    Set WordDoc = WordApp.Documents.Add(strTemplateDocumentPath)
34
35    Dim WordContentControl As Word.ContentControl
36    
37    For Each WordContentControl In WordDoc.ContentControls
38        Select Case WordContentControl.Title
39            Case "発行年月日"
40                WordContentControl.Range.Text = Date
41            Case Else
42                '何もしない
43        End Select
44    Next
45
46    WordApp.Activate
47    
48    Set WordDoc = Nothing
49    Set WordApp = Nothing
50
51End Sub

投稿2023/05/09 08:49

sk.exe

総合スコア1073

退会済みユーザー

2023/05/09 08:52

ご返信いただきありがとございます！！修正できるかやってみます！申し訳ありません、社内にVBAがわかる人が私しかおらず管理部門の方の作業効率化のお願いがされていて困っていたのです。

退会済みユーザー

2023/05/10 02:09

申し訳ありませんご教示いただきましたプログラムを行いましたが自分の設定した日付選択コントロールに本日の日付が入力されません、何が問題でしょうか？　日付選択コントロールの配置はご教示いただきました通りにしています。少し修正し下記の様になっています Private Sub ToggleButton3_Click() Dim strTemplateDocumentPath As String Dim dtToday As Date strTemplateDocumentPath = "C:\Users\boy_a\Downloads\zaishoku.docx" If Dir(strTemplateDocumentPath) = "" Then MsgBox "在職証明書のWordテンプレート文書""" & strTemplateDocumentPath & """が見つかりません！", _ vbCritical, _ "ファイル参照エラー" Exit Sub End If If MsgBox("在職証明書の作成を開始しますか？", _ vbQuestion + vbYesNo + vbDefaultButton2, _ "実行確認") = vbNo Then Exit Sub End If Dim WordApp As Word.Application Dim WordDoc As Word.Document On Error Resume Next Set WordApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Set WordApp = CreateObject("Word.Application") End If On Error GoTo 0 WordApp.Visible = True Set WordDoc = WordApp.Documents.Open(strTemplateDocumentPath) dtToday = Date Dim WordContentControl As Word.ContentControl For Each WordContentControl In WordDoc.ContentControls Select Case WordContentControl.Title Case "発行年月日" WordContentControl.Range.Text = Format(Date, "yyyy年MM月dd日") Case Else '何もしない End Select Next WordApp.Activate Set WordDoc = Nothing Set WordApp = Nothing End Sub

sk.exe

2023/05/10 02:25 編集

> 自分の設定した日付選択コントロールに本日の日付が入力されません、何が問題でしょうか？ > Select Case WordContentControl.Title > Case "発行年月日" 日付選択コンテンツコントロールの[タイトル]プロパティが"発行年月日"に設定されていないからではないでしょうか。 > WordContentControl.Range.Text = Format(Date, "yyyy年MM月dd日") また、この部分に関しては Format 関数を噛まさず、Date 関数の戻り値をそのまま代入すれば充分です。表示書式は日付選択コンテンツコントロール側で設定したものが適用されますので。ちなみに Format 関数によって和暦形式の日付文字列を取得したい場合は、次のように記述すればよいでしょう。 Format(Date, "ggge年m月d日")

退会済みユーザー

2023/05/10 05:39

教えていただきました様に発行年月日とし、プログラムの修正も試みましたが本日の日付が記載されてません、質問文の最後に今の状況のスクリーンショットを記載しましたのでもし、お判りいただけけそうでしたらご教示いただけますか？ご迷惑おかけいたします。

sk.exe

2023/05/10 06:13

画像を拝見した限りの印象では、日付選択コンテンツコントロール内の段落全体のフォントの色が白に設定されているように見受けられます。 > WordContentControl.Range.Text = Format(Date, "yyyy年MM月dd日") とりあえず上記のステートメントをブレークポイントに設定しておいた状態でマクロを実行し、その箇所でコードの実行が一時停止するかどうかを確認してみて下さい。それからF8キーをクリックしながらステップイン実行し、正常にマクロの実行が終了されたことを確認出来たら、その状態での日付選択コンテンツコントロール内のテキスト全体を範囲選択してクリップボードにコピーし、他のアプリ（できればメモ帳が良いです）に貼り付けてみて下さい。

退会済みユーザー

2023/05/10 07:13

今記載いただいた通りにし、メモ帳に張り付けたら本日の日付が記載されていることが確認できました！しかし文字が白いようで黒くしたらできそうです。もうすこしみてみます!ありがとうございました！

退会済みユーザー

2023/05/10 08:13

やりたかったことができました！ありがとうございました！！！！

行動規範の内容に同意します