移动到其他文件夹时宏不能正常工作

时间:2017-07-18 12:51:24

标签: vba excel-vba excel

我在更改文件夹位置后遇到了一个问题,即我的宏不同步。我有一个宏将excel信息复制到word文档模板。当它们在我的C:\驱动器中时,它运行顺畅,没有错误。现在我想把它移到一个公共服务器上,这样我的同事也可以使用它,当我这样做时,一些曾经完美工作的宏被1或2个空格偏移或者甚至没有将信息放在正确的位置。当我将文档传回我的C:\驱动器时,它们再次完美地工作。我很困惑这个问题是什么,所以如果你们中的任何人能够提供帮助,我们将非常感激。谢谢。

Sub GageTest2()

Dim objWord As Object
Dim objDoc As Object
Dim i As Integer
Dim Rng As Range
Dim NumRows As Integer

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open("P:\New Gage Lab Process\Gage Lab Form Template.docm")
'This opens Template

 Dim StrValue As String

For i = 2 To 6
'This populates the Gage ID

 objDoc.Activate

 StrValue = Cells(i + 1, 1)

 objWord.Selection.MoveDown
 objWord.Selection.TypeText Text:=StrValue

    If StrValue = "" Then
    Exit For

    End If
 Next i

 For i = 2 To 6
'This populates the Gage Type
    objDoc.Activate

Set Rng = Range("A3:A7")
NumRows = Application.WorksheetFunction.CountA(Rng)

StrValue = Cells(i + 1, 3)

If NumRows = 5 Then
    objWord.Selection.MoveDown count:=5
    objWord.Selection.TypeText Text:=StrValue
    objWord.Selection.MoveDown count:=-4
Else
'Do Nothing
End If

If NumRows = 4 Then
    objWord.Selection.MoveDown count:=5
    objWord.Selection.TypeText Text:=StrValue
    objWord.Selection.MoveDown count:=-4
Else
'Do Nothing
End If

If NumRows = 3 Then
    objWord.Selection.MoveDown count:=6
    objWord.Selection.TypeText Text:=StrValue
    objWord.Selection.MoveDown count:=-5
Else
'Do Nothing
End If

If NumRows = 2 Then
    objWord.Selection.MoveDown count:=7
    objWord.Selection.TypeText Text:=StrValue
    objWord.Selection.MoveDown count:=-6
Else
'Do Nothing
End If

If NumRows = 1 Then
    objWord.Selection.MoveDown count:=8
    objWord.Selection.TypeText Text:=StrValue
    objWord.Selection.MoveDown count:=-7
Else
'Do Nothing
End If

    If StrValue = "" Then
     Exit For

End If

Next i
End Sub

1 个答案:

答案 0 :(得分:0)

如果没有您正在使用的文件,我会建议您检查sting是否为空或在行的Count函数中出现错误。

对于if语句,你可以尝试这样的事情。

If StrValue = "" or StrValue = vbNullString Then
     Exit For
End If

或计数方法中存在错误,您可以尝试使用

NumRows = Application.WorksheetFunction.Count(Rng)

希望这会有所帮助