将短签名+日期添加到现有文本段落并格式化整行
Add short signature + date to an existing paragraph of text and format the whole line
问题:
我想输入一段文字,添加我的简短签名 + 日期 + 时间并格式化所有内容,以便其他人可以看到我将此评论添加到邮件中。
示例:
这是我对该主题的个人评论 // Signature Tom, 22.08.21, 14:00(<- 通过 VBA 添加最后一部分 - 代码并将整个段落用红色和斜体 VBA)
尊敬的先生或女士
...-> 邮件正文
此致
我有什么
到目前为止,它是两个独立的 VBA 子例程,我通过网络反复试验设法创建了它,但我希望一步到位(因为我必须一次又一次地调用它们) .
第一名:
Option Explicit
Public Sub AddShortSignature()
Dim xDoc As Object
Dim xSel As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
Case "Inspector"
Set xDoc = Application.ActiveInspector.WordEditor
End Select
Set xSel = xDoc.Application.Selection
xSel.InsertBefore Format(Now, "DD/MM/YYYY hh/mm")
xSel.InsertBefore Format(" // Tom., ")
Set xDoc = Nothing
Set xSel = Nothing
SendKeys "{End}", True
SendKeys "+{Home}", True
End Sub
第二,根据我的喜好格式化所有内容:
Sub formateverything()
Dim objDoc As Object
Dim objSel As Object
Set objDoc = ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.Font.Name = "Arial"
objSel.Font.Italic = True
objSel.Font.Bold = False
objSel.Font.Underline = False
objSel.Font.Color = RGB(0, 0, 0)
objSel.Font.Size = 14
End Sub
此代码将光标设置到消息字段的结束位置,并插入一个'signature'。有了这个,你可以设置任何你想要的位置。
Public Sub OutlookMail_SetCursorAT()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim Range As Object
Dim Pos As Long
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Set the cursor to the end position of the message field
If Not Doc Is Nothing Then
Pos = Doc.Range.End - 1
Set Range = Doc.Range(Pos, Pos)
Range.Select
End If
' Signature
Dim mySignature As String
mySignature = vbCrLf & Format(" // Tom., ")
mySignature = mySignature & vbCrLf & Format(Now, "DD/MM/YYYY hh/mm")
Range.InsertAfter mySignature
End Sub
正如我在你的照片中看到的那样,你的评论和签名出现在邮件的顶部(第一段),所以这就是我想出的。
Public Sub OutlookMail_CommentAndSignature()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim mySignature As String
Dim oPara As Object ' paragraph
Dim paraText As String ' paragraph text
Dim paraLength As Integer ' paragraph length
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Signature
mySignature = " // Tom., " & Format(Now, "DD/MM/YYYY hh:mm") & vbCrLf
' ' First paragraph: comment + signature
' Set oPara = Doc.Paragraphs(1).Range
' paraLength = Len(oPara.Text)
' oPara.Text = Left(oPara.Text, paraLength - 1) ' without vbCrLf
' oPara.Text = oPara.Text & mySignature
' ' format first paragraph
' oPara.Font.Italic = wdToggle
' oPara.Font.ColorIndex = wdRed
' Selected text
Dim selRange As Object: Set selRange = Doc.Application.Selection.Range
' set text range to italic and red
selRange.InsertAfter mySignature
' format first paragraph
selRange.Font.Italic = wdToggle
selRange.Font.ColorIndex = wdRed
End Sub
问题:
我想输入一段文字,添加我的简短签名 + 日期 + 时间并格式化所有内容,以便其他人可以看到我将此评论添加到邮件中。
示例:
这是我对该主题的个人评论 // Signature Tom, 22.08.21, 14:00(<- 通过 VBA 添加最后一部分 - 代码并将整个段落用红色和斜体 VBA)
尊敬的先生或女士
...-> 邮件正文
此致
我有什么
到目前为止,它是两个独立的 VBA 子例程,我通过网络反复试验设法创建了它,但我希望一步到位(因为我必须一次又一次地调用它们) .
第一名:
Option Explicit
Public Sub AddShortSignature()
Dim xDoc As Object
Dim xSel As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
Case "Inspector"
Set xDoc = Application.ActiveInspector.WordEditor
End Select
Set xSel = xDoc.Application.Selection
xSel.InsertBefore Format(Now, "DD/MM/YYYY hh/mm")
xSel.InsertBefore Format(" // Tom., ")
Set xDoc = Nothing
Set xSel = Nothing
SendKeys "{End}", True
SendKeys "+{Home}", True
End Sub
第二,根据我的喜好格式化所有内容:
Sub formateverything()
Dim objDoc As Object
Dim objSel As Object
Set objDoc = ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.Font.Name = "Arial"
objSel.Font.Italic = True
objSel.Font.Bold = False
objSel.Font.Underline = False
objSel.Font.Color = RGB(0, 0, 0)
objSel.Font.Size = 14
End Sub
此代码将光标设置到消息字段的结束位置,并插入一个'signature'。有了这个,你可以设置任何你想要的位置。
Public Sub OutlookMail_SetCursorAT()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim Range As Object
Dim Pos As Long
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Set the cursor to the end position of the message field
If Not Doc Is Nothing Then
Pos = Doc.Range.End - 1
Set Range = Doc.Range(Pos, Pos)
Range.Select
End If
' Signature
Dim mySignature As String
mySignature = vbCrLf & Format(" // Tom., ")
mySignature = mySignature & vbCrLf & Format(Now, "DD/MM/YYYY hh/mm")
Range.InsertAfter mySignature
End Sub
正如我在你的照片中看到的那样,你的评论和签名出现在邮件的顶部(第一段),所以这就是我想出的。
Public Sub OutlookMail_CommentAndSignature()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim mySignature As String
Dim oPara As Object ' paragraph
Dim paraText As String ' paragraph text
Dim paraLength As Integer ' paragraph length
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Signature
mySignature = " // Tom., " & Format(Now, "DD/MM/YYYY hh:mm") & vbCrLf
' ' First paragraph: comment + signature
' Set oPara = Doc.Paragraphs(1).Range
' paraLength = Len(oPara.Text)
' oPara.Text = Left(oPara.Text, paraLength - 1) ' without vbCrLf
' oPara.Text = oPara.Text & mySignature
' ' format first paragraph
' oPara.Font.Italic = wdToggle
' oPara.Font.ColorIndex = wdRed
' Selected text
Dim selRange As Object: Set selRange = Doc.Application.Selection.Range
' set text range to italic and red
selRange.InsertAfter mySignature
' format first paragraph
selRange.Font.Italic = wdToggle
selRange.Font.ColorIndex = wdRed
End Sub