teratail
回答率
85.47%
質問するログイン新規登録
トップVBAに関する質問在職証明のVBAマクロに本日の日付を記載したい

編集履歴

質問編集履歴

7

ブレーキングポイントを記載

2023/05/10 07:08

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -162,6 +162,7 @@
162
162
  Next
163
163
  End Sub
164
164
 
165
+ ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-10/dd3eb73e-3ba9-48f8-ad12-4ea7c72affb3.png)
165
166
 
166
167
 
167
168
 
@@ -172,4 +173,3 @@
172
173
 
173
174
 
174
175
 
175
-
VBA

6

追記

2023/05/10 05:37

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -99,3 +99,77 @@
99
99
  Set wordDoc = Nothing
100
100
  Set wordApp = Nothing
101
101
  End Sub
102
+
103
+ 追記分
104
+ **********************************
105
+
106
+
107
+ ご教示いただきました様に修正しましたがコンテンツコントロールに記載ができません。
108
+
109
+
110
+ ![![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-10/85b7dca2-2e63-4d1f-b5ca-fde605158a02.png)](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-10/e1e5711c-8dd3-40bf-96dd-72dde1c01d61.png)
111
+ 下記のようなプログラムを書きエラーは出ていませんが記載がされません。
112
+
113
+ Private Sub ToggleButton3_Click()
114
+
115
+ Dim strTemplateDocumentPath As String
116
+ Dim dtToday As Date
117
+
118
+ strTemplateDocumentPath = "C:\Users\boy_a\Downloads\zaishoku.docx"
119
+
120
+ If Dir(strTemplateDocumentPath) = "" Then
121
+ MsgBox "在職証明書のWordテンプレート文書""" & strTemplateDocumentPath & """が見つかりません！", _
122
+ vbCritical, _
123
+ "ファイル参照エラー"
124
+ Exit Sub
125
+ End If
126
+
127
+ If MsgBox("在職証明書の作成を開始しますか？", _
128
+ vbQuestion + vbYesNo + vbDefaultButton2, _
129
+ "実行確認") = vbNo Then
130
+ Exit Sub
131
+ End If
132
+
133
+ Dim WordApp As Word.Application
134
+ Dim WordDoc As Word.Document
135
+
136
+ On Error Resume Next
137
+ Set WordApp = GetObject(, "Word.Application")
138
+ If Err.Number <> 0 Then
139
+ Err.Clear
140
+ On Error GoTo 0
141
+ Set WordApp = CreateObject("Word.Application")
142
+ End If
143
+ On Error GoTo 0
144
+ WordApp.Visible = True
145
+
146
+
147
+
148
+ Set WordDoc = WordApp.Documents.Open(strTemplateDocumentPath)
149
+
150
+ dtToday = Date
151
+
152
+ Dim WordContentControl As Word.ContentControl
153
+
154
+
155
+ For Each WordContentControl In WordDoc.ContentControls
156
+ Select Case WordContentControl.Title
157
+ Case "発行年月日"
158
+ WordContentControl.Range.Text = Format(Date, "yyyy年MM月dd日")
159
+ Case Else
160
+ '何もしない
161
+ End Select
162
+ Next
163
+ End Sub
164
+
165
+
166
+
167
+
168
+
169
+
170
+
171
+
172
+
173
+
174
+
175
+
VBA

5

質問の書き方を若干修正しました

2023/05/08 06:10

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -1,101 +1,101 @@
1
- [リンク内容]([url](![url](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-02/a3406e26-2db4-4872-b7bf-51ec9d25fd18.png)))
1
+ 在職証明のマクロで
2
-
3
- 在職証明のマクロで日付の位置を矢印の位置にずらしたいのと
2
+ ①　日付の位置を矢印の位置にずらしたい（画像赤丸の位置から矢印の先に位置変更）
4
- 本日の日付が年が2つあるので削除したいです。
3
+ ②　本日の日付に”年”が2つあるので削除したいです。
5
4
 
6
5
  今のプログラムはこちらなのですがどうしたら良いかご教示いただけませんでしょうか？
7
6
 
7
+ ここに実現したいことを箇条書きで書いてください。
8
+
8
- ************************************************************************************
9
+ 在職証明の本日の日付を一番下の位置から規定の位置に記載できるようにしたい
10
+ その際大本の文字は削除したい
11
+ イメージ説明
12
+
13
+ 該当のソースコード
9
14
  Private Sub ToggleButton1_Click()
10
- Dim wordApp As Object
15
+ Dim wordApp As Object
11
- Dim wordDoc As Object
16
+ Dim wordDoc As Object
12
17
 
13
- ' Wordアプリケーションを起動する
18
+ ' Wordアプリケーションを起動する
14
- Set wordApp = CreateObject("Word.Application")
19
+ Set wordApp = CreateObject("Word.Application")
15
20
 
16
- ' 既存のWordファイルを開く
21
+ ' 既存のWordファイルを開く
17
- Set wordDoc = wordApp.Documents.Open("C:\Users\boy_a\Downloads\zaishoku.docx")
22
+ Set wordDoc = wordApp.Documents.Open("C:\Users\boy_a\Downloads\zaishoku.docx")
18
23
 
19
- ' Word文書の最後にカーソルを移動
24
+ ' Word文書の最後にカーソルを移動
20
- wordApp.Selection.EndKey Unit:=wdStory
25
+ wordApp.Selection.EndKey Unit:=wdStory
21
26
 
22
- ' テキストボックスの値を取得
27
+ ' テキストボックスの値を取得
23
- Dim zipCode As String
28
+ Dim zipCode As String
24
- zipCode = TextBox1.Value
29
+ zipCode = TextBox1.Value
25
- Dim address As String
30
+ Dim address As String
26
- address = TextBox2.Value
31
+ address = TextBox2.Value
27
- Dim name As String
32
+ Dim name As String
28
- name = TextBox3.Value
33
+ name = TextBox3.Value
29
- Dim birth As String
34
+ Dim birth As String
30
- birth = TextBox4.Value
35
+ birth = TextBox4.Value
31
- Dim shokui As String
36
+ Dim shokui As String
32
- name = TextBox6.Value
37
+ name = TextBox6.Value
33
38
 
34
- ' WordTableの操作を追加する
39
+ ' WordTableの操作を追加する
35
- Dim WordTable As Object
40
+ Dim WordTable As Object
36
- Set WordTable = wordDoc.Tables(1)
41
+ Set WordTable = wordDoc.Tables(1)
37
42
 
38
- With WordTable.Cell(1, 2).Range
43
+ With WordTable.Cell(1, 2).Range
39
- .MoveEnd wdCharacter, -1
44
+ .MoveEnd wdCharacter, -1
40
- .InsertAfter Me.TextBox2.Value
45
+ .InsertAfter Me.TextBox2.Value
41
- End With
46
+ End With
42
47
 
43
- With WordTable.Cell(2, 2).Range
48
+ With WordTable.Cell(2, 2).Range
44
- .MoveEnd wdCharacter, -1
49
+ .MoveEnd wdCharacter, -1
45
- .InsertAfter Me.TextBox3.Value
50
+ .InsertAfter Me.TextBox3.Value
46
- End With
51
+ End With
47
52
 
48
- With WordTable.Cell(3, 2).Range
53
+ With WordTable.Cell(3, 2).Range
49
- .MoveEnd wdCharacter, -1
54
+ .MoveEnd wdCharacter, -1
50
- .InsertAfter Me.TextBox4.Value
55
+ .InsertAfter Me.TextBox4.Value
51
- End With
56
+ End With
52
57
 
53
- With WordTable.Cell(4, 2).Range
58
+ With WordTable.Cell(4, 2).Range
54
- .MoveEnd wdCharacter, -1
59
+ .MoveEnd wdCharacter, -1
55
- .InsertAfter Me.TextBox6.Value
60
+ .InsertAfter Me.TextBox6.Value
56
- End With
61
+ End With
57
62
 
58
- Set WordTable = Nothing
63
+ Set WordTable = Nothing
59
64
 
60
- ' 本日の日付を取得
65
+ ' 本日の日付を取得
61
- Dim currentDate As Date
66
+ Dim currentDate As Date
62
- currentDate = Date
67
+ currentDate = Date
63
68
 
64
- ' 令和の年号と年数を取得
69
+ ' 令和の年号と年数を取得
65
- Dim warekiYear As Integer
70
+ Dim warekiYear As Integer
66
- Dim warekiEra As String
71
+ Dim warekiEra As String
67
- warekiYear = Year(currentDate) - 2018 ' 令和元年が2019年なので、年数から2018を引く
72
+ warekiYear = Year(currentDate) - 2018 ' 令和元年が2019年なので、年数から2018を引く
68
73
 
69
- If warekiYear = 1 Then
74
+ If warekiYear = 1 Then
70
- warekiEra = "令和元年"
75
+ warekiEra = "令和元年"
71
- Else
76
+ Else
72
- warekiEra = "令和" & warekiYear & "年"
77
+ warekiEra = "令和" & warekiYear & "年"
73
- End If
78
+ End If
74
79
 
75
- ' 指定した位置に令和の日付を挿入（年の部分を削除）
80
+ ' 指定した位置に令和の日付を挿入（年の部分を削除）
76
- Dim modifiedDate As String
81
+ Dim modifiedDate As String
77
- modifiedDate = warekiEra & Replace(Format(currentDate, "年mm月dd日"), Year(currentDate) & "年", "")
82
+ modifiedDate = warekiEra & Replace(Format(currentDate, "年mm月dd日"), Year(currentDate) & "年", "")
78
83
 
79
- ' Wordドキュメントの一番下の行に移動
84
+ ' Wordドキュメントの一番下の行に移動
80
- wordApp.Selection.EndKey 6
85
+ wordApp.Selection.EndKey 6
81
- wordApp.Selection.MoveDown 5, 1
86
+ wordApp.Selection.MoveDown 5, 1
82
87
 
83
- ' 令和の日付を挿入
88
+ ' 令和の日付を挿入
84
- wordApp.Selection.TypeText modifiedDate
89
+ wordApp.Selection.TypeText modifiedDate
85
90
 
86
- ' Wordの文書を保存して閉じる
91
+ ' Wordの文書を保存して閉じる
87
- wordDoc.Save
92
+ wordDoc.Save
88
- wordDoc.Close
93
+ wordDoc.Close
89
94
 
90
- ' Wordアプリケーションを終了する
95
+ ' Wordアプリケーションを終了する
91
- wordApp.Quit
96
+ wordApp.Quit
92
97
 
93
- ' オブジェクトを解放する
98
+ ' オブジェクトを解放する
94
- Set wordDoc = Nothing
99
+ Set wordDoc = Nothing
95
- Set wordApp = Nothing
100
+ Set wordApp = Nothing
96
101
  End Sub
97
-
98
-
99
- ************************************************************************************
100
- ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-02/1da11fa5-2bd2-4b70-84e7-38591c9b21ad.png)
101
-
VBA

4

図の添付

2023/05/02 08:33

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -97,5 +97,5 @@
97
97
 
98
98
 
99
99
  ************************************************************************************
100
+ ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-02/1da11fa5-2bd2-4b70-84e7-38591c9b21ad.png)
100
101
 
101
-
VBA

3

今の現状に沿うように修正しました。

2023/05/02 08:32

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -1,104 +1,101 @@
1
+ [リンク内容]([url](![url](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-02/a3406e26-2db4-4872-b7bf-51ec9d25fd18.png)))
2
+
1
- ### 実現したいこと
3
+ 在職証明のマクロで日付の位置を矢印の位置にずらしたいのと
2
- 在職証明のVBAのアプリを書きたいです。
4
+ 本日の日付が年が2つあるので削除したいです。
5
+
6
+ 今のプログラムはこちらなのですがどうしたら良いかご教示いただけませんでしょうか？
7
+
8
+ ************************************************************************************
9
+ Private Sub ToggleButton1_Click()
10
+ Dim wordApp As Object
11
+ Dim wordDoc As Object
12
+
13
+ ' Wordアプリケーションを起動する
14
+ Set wordApp = CreateObject("Word.Application")
15
+
16
+ ' 既存のWordファイルを開く
17
+ Set wordDoc = wordApp.Documents.Open("C:\Users\boy_a\Downloads\zaishoku.docx")
18
+
19
+ ' Word文書の最後にカーソルを移動
20
+ wordApp.Selection.EndKey Unit:=wdStory
21
+
22
+ ' テキストボックスの値を取得
23
+ Dim zipCode As String
24
+ zipCode = TextBox1.Value
25
+ Dim address As String
26
+ address = TextBox2.Value
27
+ Dim name As String
28
+ name = TextBox3.Value
29
+ Dim birth As String
30
+ birth = TextBox4.Value
31
+ Dim shokui As String
32
+ name = TextBox6.Value
33
+
34
+ ' WordTableの操作を追加する
35
+ Dim WordTable As Object
36
+ Set WordTable = wordDoc.Tables(1)
37
+
38
+ With WordTable.Cell(1, 2).Range
39
+ .MoveEnd wdCharacter, -1
40
+ .InsertAfter Me.TextBox2.Value
41
+ End With
42
+
43
+ With WordTable.Cell(2, 2).Range
44
+ .MoveEnd wdCharacter, -1
45
+ .InsertAfter Me.TextBox3.Value
46
+ End With
47
+
48
+ With WordTable.Cell(3, 2).Range
49
+ .MoveEnd wdCharacter, -1
50
+ .InsertAfter Me.TextBox4.Value
51
+ End With
52
+
53
+ With WordTable.Cell(4, 2).Range
54
+ .MoveEnd wdCharacter, -1
55
+ .InsertAfter Me.TextBox6.Value
56
+ End With
57
+
58
+ Set WordTable = Nothing
59
+
60
+ ' 本日の日付を取得
61
+ Dim currentDate As Date
62
+ currentDate = Date
63
+
64
+ ' 令和の年号と年数を取得
65
+ Dim warekiYear As Integer
66
+ Dim warekiEra As String
67
+ warekiYear = Year(currentDate) - 2018 ' 令和元年が2019年なので、年数から2018を引く
68
+
69
+ If warekiYear = 1 Then
70
+ warekiEra = "令和元年"
71
+ Else
72
+ warekiEra = "令和" & warekiYear & "年"
73
+ End If
74
+
75
+ ' 指定した位置に令和の日付を挿入（年の部分を削除）
76
+ Dim modifiedDate As String
77
+ modifiedDate = warekiEra & Replace(Format(currentDate, "年mm月dd日"), Year(currentDate) & "年", "")
78
+
79
+ ' Wordドキュメントの一番下の行に移動
80
+ wordApp.Selection.EndKey 6
81
+ wordApp.Selection.MoveDown 5, 1
82
+
83
+ ' 令和の日付を挿入
84
+ wordApp.Selection.TypeText modifiedDate
85
+
86
+ ' Wordの文書を保存して閉じる
87
+ wordDoc.Save
88
+ wordDoc.Close
89
+
90
+ ' Wordアプリケーションを終了する
91
+ wordApp.Quit
92
+
93
+ ' オブジェクトを解放する
94
+ Set wordDoc = Nothing
95
+ Set wordApp = Nothing
96
+ End Sub
3
97
 
4
98
 
5
- ここに実現したいことを箇条書きで書いてください。
6
- 本日の日付を取得し　在職証明のwordに記載する。
99
+ ************************************************************************************
7
-
8
- _イタリックテキスト_
9
100
 
10
101
 
11
- ### 該当のソースコード
12
-
13
- VBA
14
- ソースコード
15
- *********************************************************************************************
16
- Private Sub ToggleButton1_Click()
17
-
18
- Dim WordApp As Word.Application
19
- Dim WordDoc As Word.Document
20
-
21
- 'Wordアプリケーションを起動する
22
- Set WordApp = CreateObject("Word.Application")
23
-
24
- '既存のWordファイルを開く
25
- Set WordDoc = WordApp.Documents.Open("C:\Users\boy_a\Downloads\zaishoku.docx")
26
-
27
- 'Word文書の最後にカーソルを移動
28
- WordApp.Selection.EndKey Unit:=wdStory
29
-
30
- 'テキストボックスの値を取得
31
- Dim zipCode As String
32
- zipCode = TextBox1.Value
33
- Dim address As String
34
- address = TextBox2.Value
35
- Dim name As String
36
- name = TextBox3.Value
37
- Dim birth As String
38
- birth = TextBox4.Value
39
- Dim shokui As String
40
- name = TextBox6.Value
41
-
42
-
43
- ' WordTableの操作を追加する
44
- Dim WordTable As Word.Table
45
- Set WordTable = WordDoc.Tables(1)
46
-
47
- With WordTable.Cell(1, 2).Range
48
- .MoveEnd wdCharacter, -1
49
- .InsertAfter Me.TextBox2.Value
50
- End With
51
-
52
- With WordTable.Cell(2, 2).Range
53
- .MoveEnd wdCharacter, -1
54
- .InsertAfter Me.TextBox3.Value
55
- End With
56
-
57
-
58
- With WordTable.Cell(3, 2).Range
59
- .MoveEnd wdCharacter, -1
60
- .InsertAfter Me.TextBox4.Value
61
- End With
62
-
63
-
64
-
65
- With WordTable.Cell(4, 2).Range
66
- .MoveEnd wdCharacter, -1
67
- .InsertAfter Me.TextBox6.Value
68
- End With
69
- Set WordTable = Nothing
70
- 'Wordの文書を保存して閉じる
71
- WordDoc.Save
72
-
73
- 'Wordアプリケーションを終了する
74
- WordApp.Quit
75
-
76
- 'オブジェクトを解放する
77
- Set WordDoc = Nothing
78
- Set WordApp = Nothing
79
- End Sub
80
-
81
- ***********************************************************************************
82
- このプログラムに下記のような分を追記したいです。
83
- ' 本日の日付を取得
84
-
85
- Dim currentDate As String
86
- currentDate = Format(Date, "yyyy年mm月dd日")
87
-
88
- ' ワードの下から8行目の右端に本日の日付を挿入する
89
- WordDoc.Content.Paragraphs.Last.Range.InsertAfter vbCrLf & Space(8) & currentDate
90
-
91
- ***************************************************************************************
92
-
93
- このプログラムを追記すると下の方に本日の日付が出るのですが
94
- これを狙った位置に書きたいのです。
95
-
96
-
97
- ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/ac92dae2-a88b-4730-99fd-484350bdf8ef.png)
98
- 下から13行目の右端に記載し、できれば今の令和年月日という文字を削除し、記載したいのです。
99
- 画像の位置にある令和年月日の位置に書きたいです。
100
-
101
- 出来れば2023年ではなく令和の形式で書きたいのですが狙った位置に書くのやり方がわからず悩んでいます。
102
-
103
-
104
- 度々お聞きして申し訳ありませんが、解決可能な方いらっしゃったらご教示いただけませんでしょうか？
VBA

2

挿入のpngを一枚書く

2023/05/01 08:59

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -92,8 +92,9 @@
92
92
 
93
93
  このプログラムを追記すると下の方に本日の日付が出るのですが
94
94
  これを狙った位置に書きたいのです。
95
+
96
+
95
- ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/e581d2bf-44d6-4548-b6f0-2198561d9590.png)![
97
+ ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/ac92dae2-a88b-4730-99fd-484350bdf8ef.png)
96
- ](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/4f45d470-9065-41db-a149-d92e8ec17f29.png)
97
98
  下から13行目の右端に記載し、できれば今の令和年月日という文字を削除し、記載したいのです。
98
99
  画像の位置にある令和年月日の位置に書きたいです。
99
100
 
VBA

1

プログラムのメイン部分を囲いました。

2023/05/01 08:57

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -12,7 +12,7 @@
12
12
 
13
13
  VBA
14
14
  ソースコード
15
-
15
+ *********************************************************************************************
16
16
  Private Sub ToggleButton1_Click()
17
17
 
18
18
  Dim WordApp As Word.Application
@@ -66,11 +66,7 @@
66
66
  .MoveEnd wdCharacter, -1
67
67
  .InsertAfter Me.TextBox6.Value
68
68
  End With
69
-
70
-
71
-
72
69
  Set WordTable = Nothing
73
-
74
70
  'Wordの文書を保存して閉じる
75
71
  WordDoc.Save
76
72
 
@@ -81,24 +77,23 @@
81
77
  Set WordDoc = Nothing
82
78
  Set WordApp = Nothing
83
79
  End Sub
80
+
81
+ ***********************************************************************************
82
+ このプログラムに下記のような分を追記したいです。
84
83
  ' 本日の日付を取得
85
84
 
86
- ```
87
-
88
- このプログラムに本日の日付を書きたいです。
89
-
90
- ### 試したこと
91
- ' 本日の日付を取得
92
85
  Dim currentDate As String
93
86
  currentDate = Format(Date, "yyyy年mm月dd日")
94
87
 
95
88
  ' ワードの下から8行目の右端に本日の日付を挿入する
96
89
  WordDoc.Content.Paragraphs.Last.Range.InsertAfter vbCrLf & Space(8) & currentDate
90
+
91
+ ***************************************************************************************
97
92
 
98
93
  このプログラムを追記すると下の方に本日の日付が出るのですが
99
94
  これを狙った位置に書きたいのです。
100
- ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/e581d2bf-44d6-4548-b6f0-2198561d9590.png)
95
+ ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/e581d2bf-44d6-4548-b6f0-2198561d9590.png)![
101
-
96
+ ](https://ddjkaamml8q8x.cloudfront.net/questions/2023-05-01/4f45d470-9065-41db-a149-d92e8ec17f29.png)
102
97
  下から13行目の右端に記載し、できれば今の令和年月日という文字を削除し、記載したいのです。
103
98
  画像の位置にある令和年月日の位置に書きたいです。
104
99
 
VBA