我有点迷失....我有一个宏嵌入式单词模板，分发给我组织中的所有用户，并且它用于将银行对帐单打印到PDF。
宏作为一个整体工作并生成PDF，但4个用户中只有1个用户将以正确的格式获取PDF。
其他3个用户将获得完全相同的错误结果，例如，其中一个语句的地址将缺少一行。
所有4个用户使用相同的操作系统，MS Office版本，并且位于同一网络上。
为什么宏会在用户之间以不同的方式运行？
以下是代码：
Sub StatementFormat()
'
' StatementFormat Macro
'
'
'Turn off screen update
Application.ScreenUpdating = False
'set up file path and special mailing folder
Dim currentFilePath As String, specialMailingPath As String, singleSheetPath As String, multiSheetPath As String, currentDate As String
currentDate = Format(Now, "yyyymmddhhmmss")
currentFilePath = ActiveDocument.Path & "\" & "StatementProcessing" & "_" & currentDate & "\"
singleSheetPath = currentFilePath & "SingleSheet" & "\"
multiSheetPath = currentFilePath & "MultiSheet" & "\"
specialMailingPath = currentFilePath & "SpecialMailing" & "\"
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.folderexists(currentFilePath) Then
fso.createfolder (currentFilePath)
End If
If Not fso.folderexists(specialMailingPath) Then
fso.createfolder (specialMailingPath)
End If
If Not fso.folderexists(singleSheetPath) Then
fso.createfolder (singleSheetPath)
End If
If Not fso.folderexists(multiSheetPath) Then
fso.createfolder (multiSheetPath)
End If
'Save the working document
ActiveDocument.SaveAs2 FileName:=currentFilePath & "SpoolFile_" & currentDate
'Set font size
ActiveDocument.Range.Select
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
'Selection.HomeKey
'Get number of lines in document
Selection.WholeStory
Selection.MoveRight unit:=wdCharacter, Count:=1
Dim i1 As Integer, i2 As Integer, LineCount As Long, rTemp As Range
Do
i1 = Selection.Information(wdFirstCharacterLineNumber)
Selection.GoTo what:=wdGoToLine, which:=wdGoToPrevious, Count:=1, Name:=""
LineCount = LineCount + 1
i2 = Selection.Information(wdFirstCharacterLineNumber)
Loop Until i1 = i2
'Go to top of document
Selection.WholeStory
Selection.MoveLeft unit:=wdCharacter, Count:=1
'Loop through all lines
Dim currentPosition As Long, currentAccountNumber As String, statementStartLine As Long, statementEndLine As Long, statementLength As Integer, newPageInd As String, statementAccountNumber As String, statementPageCount As Integer, statementAddLines As Integer, statementSeqNo As Integer
currentPosition = 1
currentAccountNumber = 99999999
statementStartLine = 0
statementAddLines = 0
statementSeqNo = 1
Do
Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
newPageInd = Selection.Text
'Check if lines are to be inserted
Dim addLines As Integer
Selection.MoveRight unit:=wdCharacter, Count:=2, Extend:=wdMove
Selection.MoveRight unit:=wdCharacter, Count:=2, Extend:=wdExtend
addLines = Selection.Text
If addLines > 0 And newPageInd <> "L" Then
'MsgBox (addLines)
Selection.HomeKey unit:=wdLine, Extend:=wdMove
Dim addLineCount As Integer
addLineCount = 0
Do
Selection.InsertBreak Type:=wdLineBreak
addLineCount = addLineCount + 1
Loop Until addLineCount = addLines
statementAddLines = statementAddLines + addLineCount
addLineCount = 0
End If
'Delete leading characters
Selection.HomeKey unit:=wdLine, Extend:=wdMove
Selection.MoveRight unit:=wdCharacter, Count:=12, Extend:=wdExtend
Selection.Delete
Selection.HomeKey unit:=wdLine, Extend:=wdMove
'Check to see if a new page is indicated
If newPageInd = "L" Then
Selection.MoveRight unit:=wdCharacter, Count:=55
Selection.MoveRight unit:=wdCharacter, Count:=8, Extend:=wdExtend
If Selection.Text <> currentAccountNumber And currentPosition <> 1 Then
statementAccountNumber = currentAccountNumber
currentAccountNumber = Selection.Text
statementEndLine = currentPosition - 1
'Select the previous statement
statementLength = statementEndLine - statementStartLine + statementAddLines
If statementPageCount > 1 Then
statementLength = statementLength + ((statementPageCount - 1) * 2)
End If
'MsgBox (statementLength)
Selection.MoveUp unit:=wdLine, Count:=1
Selection.EndKey
Selection.MoveUp unit:=wdLine, Count:=statementLength, Extend:=wdExtend
Selection.HomeKey unit:=wdLine, Extend:=wdExtend
statementAddLines = 0
'set up data
Dim originalDocument As String, newDocument As String
Selection.Copy
originalDocument = ActiveDocument.Name
Documents.Add
Selection.Paste
'Set margin and font size
ActiveDocument.PageSetup.TopMargin = CentimetersToPoints(4.7)
ActiveDocument.PageSetup.LeftMargin = CentimetersToPoints(0.4)
ActiveDocument.PageSetup.RightMargin = CentimetersToPoints(0)
ActiveDocument.Range.Select
Selection.Font.Name = "Lucida Sans Typewriter"
Selection.Font.Size = 12
Selection.Font.ColorIndex = wdDarkGrey
Selection.Paragraphs.LineSpacingRule = wdLineSpaceExactly
Selection.Paragraphs.LineSpacing = CentimetersToPoints(0.44)
'check for Special Mailing and Hold for Collection
'Go to top of document
Selection.WholeStory
Selection.MoveLeft unit:=wdCharacter, Count:=1
'check second line (address line 1) for indicator
Selection.MoveDown unit:=wdLine, Count:=1
Selection.MoveRight unit:=wdCharacter, Count:=6, Extend:=wdMove
Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.Text = "=" Then
specialMailing = True
Else
'check third line in case address line 1 has wrapped
Selection.HomeKey unit:=wdLine, Extend:=wdMove
Selection.MoveDown unit:=wdLine, Count:=1
Selection.MoveRight unit:=wdCharacter, Count:=6, Extend:=wdMove
Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.Text = "=" Then
specialMailing = True
Else
specialMailing = False
End If
End If
'save file
'ActiveDocument.SaveAs2 FileName:=currentFilePath & statementAccountNumber & "_" & Format(Now, "yyyymmddhhmmss") & "_" & statementSeqNo
If specialMailing Or statementAccountNumber = "" Or statementAccountNumber = "00000000" Or statementAccountNumber = "99999999" Then
Dim specialMailingFileName As String
specialMailingFileName = specialMailingPath & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo
'specialMailingFileName = specialMailingPath & statementSeqNo & "_" & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo
'ActiveDocument.SaveAs2 FileName:=specialMailingFileName
ActiveDocument.ExportAsFixedFormat OutputFileName:=specialMailingFileName, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
Else
If statementPageCount = 1 Then
'Save as pdf
'ActiveDocument.ExportAsFixedFormat OutputFileName:=singleSheetPath & statementSeqNo & "_" & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=singleSheetPath & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
'Print pdf
'print the single sheet statements
'format for printing
ActiveDocument.PageSetup.LeftMargin = CentimetersToPoints(0.8)
ActiveDocument.PageSetup.TopMargin = CentimetersToPoints(5.5)
With Application
.DisplayAlerts = wdAlertsNone
.PrintOut Background:=False
.DisplayAlerts = wdAlertsAll
End With
'Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p /h " & OutputFileName
Else
ActiveDocument.ExportAsFixedFormat OutputFileName:=multiSheetPath & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
'ActiveDocument.ExportAsFixedFormat OutputFileName:=multiSheetPath & statementSeqNo & "_" & statementAccountNumber & "_" & currentDate & "_" & statementSeqNo, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
End If
End If
statementSeqNo = statementSeqNo + 1
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
If ActiveDocument.Name <> originalDocument Then
Documents(originalDocument).Activate
End If
statementStartLine = currentPosition
'Return to the current position
Selection.EndKey
Selection.MoveDown unit:=wdLine, Count:=1
Selection.HomeKey
'Reset the page count
statementPageCount = 0
End If
Selection.HomeKey unit:=wdLine, Extend:=wdMove
If currentPosition <> 1 Then
Selection.InsertBreak Type:=wdPageBreak
statementPageCount = statementPageCount + 1
End If
End If
'Next line
Selection.HomeKey unit:=wdLine, Extend:=wdMove
Selection.GoTo what:=wdGoToLine, which:=wdGoToNext, Count:=1, Name:=""
currentPosition = currentPosition + 1
Loop Until currentPosition = LineCount
'Loop Until currentPosition = 15
'Turn on screen update
Application.ScreenUpdating = True
'End Statement Format
MsgBox ("Statement Format Complete")
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub