MS VBA - 运行宏没有更改文件类型

时间：2017-08-19 08:36:33

标签： vba excel-vba ms-word excel

我有一个包含以下文件的文件夹：

  1. SRJem.xlsx
  2. Master File.xltm
  3. 服务报告Printer.docx

    4. 工作簿 SRJem.xlsx 是一个文件，其中所有输入都进入（通常我从我们的保管人的手动输入中粘贴），然后由服务报告Printer.docx 立即打印（因为表格是如此扭曲，我不得不这样编码）。此外， SRJem.xlsx 的内容随后将作为报告传输到 Master File.xltm 中（请注意文件类型为Excel启用宏的模板）。

    困难的是，我必须在 Service Report Printer.docx 文件和 Master File.xltm 文件中手动运行宏。

    我尝试在 SRJem.xlsx 文件中编码，（现在将其保存为xltm文件而不是xlsx），但困难的部分是主文件宏将 SRJem.xltm 重新打开为 SRJem1.xltm ，因此会破坏主文件中需要我再次保存的代码。

    有解决方法吗？

    如果不是代码，我应该如何思考，以便在重新打开期间从单个输入文件同时运行两个代码而不改变输入文件的文件名？或

    是否存在主文件无法重新打开源xltm文件的方式？

    以下是 Master File.xltm

    的代码 
    Sub transfer_to_masterfile()

'find first empty row in database
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("1")
Dim wbSource As Workbook

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).row + 1

Set wbSource = Workbooks.Open("C:\Users\fed.staff01\Desktop\J.G.E - QS\6. EXCEL PROGRAMS\SRJem.xlsx") ' <<< path to source workbook

Set sh = wbSource.Worksheets("1")

'Now, transfer values from wbSource to wbTarget:
'ws.Cells(iRow, 1).Value = "*"
ws.Cells(iRow, 4).Value = sh.Cells(14, 1).Value
ws.Cells(iRow, 5).Value = sh.Cells(6, 4).Value

Dim mats As String
Dim row As Integer

row = 23
mats = ""

Do
    mats = mats & "  " & sh.Cells(row, 1).Value & "  " & sh.Cells(row, 3).Value & _
    "             " & sh.Cells(row, 5).Value

    If sh.Cells(row + 1, 1).Value > 0 Then
        mats = mats & vbNewLine
    End If

    If sh.Cells(row + 1, 1).Value = "" Then
        Exit Do
    End If

    row = row + 1

Loop Until row = 42

ws.Cells(iRow, 7).Value = mats

Dim hourswork As String
hourswork = ""
row = 46
Do
    hourswork = hourswork & sh.Cells(row, 5).Value & " hrs"
    If sh.Cells(row + 1, 5).Value <> "" Then
        hourswork = hourswork & vbNewLine
    End If
    If sh.Cells(row + 1, 5).Value = "" Then
        Exit Do
    End If
    row = row + 1
Loop Until row = 51
ws.Cells(iRow, 11).Value = hourswork

Dim rate As String
rate = ""
row = 46
Do
    rate = rate & sh.Cells(row, 15).Value
    If sh.Cells(row + 1, 15).Value <> "" Then
        rate = rate & vbNewLine
    End If
    If sh.Cells(row + 1, 15).Value = "" Then
        Exit Do
    End If
    row = row + 1
Loop Until row = 51
ws.Cells(iRow, 12).Value = rate

ws.Cells(iRow, 13).Value = Format(sh.Cells(20, 5), "MMM. DD, YYYY")
ws.Cells(iRow, 14).Value = Format(sh.Cells(20, 15), "MMM. DD, YYYY")
ws.Cells(iRow, 15).Value = Format(sh.Cells(43, 17), "###,###.00")
ws.Cells(iRow, 17).Value = Format(sh.Cells(52, 17), "###,###.00")

wbSource.Quit

Set wbSource = Nothing

End Sub

    虽然这是服务报告Printer.docx

    的代码 
    Sub Clear_Document()
Dim oShp As Word.Shape
Dim i As Long

For i = ActiveDocument.Shapes.Count To 1 Step -1
    Set oShp = ActiveDocument.Shapes(i)
    If oShp.Type = msoTextBox Then
        oShp.Delete
    End If
Next i
End Sub

Sub ReadyForPrinting()

sPrompt = "Please enter sheet name: "
sTitle = "Sheet Reference"
sDefault = sSheetRef
sSheetRef = InputBox(sPrompt, sTitle, sDefault)

Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open("C:\Users\fed.staff01\Desktop\J.G.E - QS\6. EXCEL PROGRAMS\SRJem.xlsx")

Dim client As Shape
Set client = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=95, Top:=115, Width:=500, Height:=20)
client.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(6, 4)
client.ThreeD.RotationX = 0
client.ThreeD.RotationY = 0
client.ThreeD.RotationZ = 3
With client.Line
    .Visible = msoFalse
End With

Dim requestdate_word As Shape
Set requestdate_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=420, Top:=127, Width:=500, Height:=20)
requestdate_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(6, 15)
requestdate_word.ThreeD.RotationX = 0
requestdate_word.ThreeD.RotationY = 0
requestdate_word.ThreeD.RotationZ = 2
With requestdate_word.Line
    .Visible = msoFalse
End With

Dim clientlocation As Shape
Set clientlocation = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=95, Top:=124, Width:=500, Height:=20)

clientlocation.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(7, 4)
clientlocation.ThreeD.RotationX = 0
clientlocation.ThreeD.RotationY = 0
clientlocation.ThreeD.RotationZ = 2
With clientlocation.Line
    .Visible = msoFalse
End With

Dim contactperson_word As Shape
Set contactperson_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=110, Top:=138, Width:=500, Height:=20)

contactperson_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(8, 4)
contactperson_word.ThreeD.RotationX = 0
contactperson_word.ThreeD.RotationY = 0
contactperson_word.ThreeD.RotationZ = 2
With contactperson_word.Line
    .Visible = msoFalse
End With

Dim telno_word As Shape
Set telno_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=400, Top:=150, Width:=500, Height:=20)

telno_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(8, 15)
telno_word.ThreeD.RotationX = 0
telno_word.ThreeD.RotationY = 0
telno_word.ThreeD.RotationZ = 2
With telno_word.Line
    .Visible = msoFalse
End With

Dim workdescription As Shape
Set workdescription = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=50, Top:=202, Width:=500, Height:=20)

workdescription.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(14, 1)
workdescription.ThreeD.RotationX = 0
workdescription.ThreeD.RotationY = 0
workdescription.ThreeD.RotationZ = 3
With workdescription.Line
    .Visible = msoFalse
End With

Dim inspectedby_word As Shape
Set inspectedby_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=80, Top:=243, Width:=500, Height:=20)

inspectedby_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(18, 1)
inspectedby_word.ThreeD.RotationX = 0
inspectedby_word.ThreeD.RotationY = 0
inspectedby_word.ThreeD.RotationZ = 3
With inspectedby_word.Line
    .Visible = msoFalse
End With

Dim datestarted As Shape
Set datestarted = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=135, Top:=258, Width:=300, Height:=20)
datestarted.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(20, 5)
datestarted.ThreeD.RotationX = 0
datestarted.ThreeD.RotationY = 0
datestarted.ThreeD.RotationZ = 2
With datestarted.Line
    .Visible = msoFalse
End With

Dim datefinished As Shape
Set datefinished = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=442, Top:=270, Width:=300, Height:=20)
datefinished.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(20, 15)
datefinished.ThreeD.RotationX = 0
datefinished.ThreeD.RotationY = 0
datefinished.ThreeD.RotationZ = 2
With datefinished.Line
    .Visible = msoFalse
End With

Dim inspecteddate_word As Shape
Set inspecteddate_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=236, Top:=250, Width:=500, Height:=20)
inspecteddate_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(18, 8)
inspecteddate_word.ThreeD.RotationX = 0
inspecteddate_word.ThreeD.RotationY = 0
inspecteddate_word.ThreeD.RotationZ = 3
With inspecteddate_word.Line
    .Visible = msoFalse
End With

Dim confirmedby_word As Shape
Set confirmedby_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=373, Top:=252, Width:=500, Height:=20)

confirmedby_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(18, 11)
confirmedby_word.ThreeD.RotationX = 0
confirmedby_word.ThreeD.RotationY = 0
confirmedby_word.ThreeD.RotationZ = 2
With confirmedby_word.Line
    .Visible = msoFalse
End With

Dim confirmeddate_word As Shape
Set confirmeddate_word = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=510, Top:=255, Width:=500, Height:=20)
confirmeddate_word.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(18, 17)
confirmeddate_word.ThreeD.RotationX = 0
confirmeddate_word.ThreeD.RotationY = 0
confirmeddate_word.ThreeD.RotationZ = 2
With confirmeddate_word.Line
    .Visible = msoFalse
End With

'merge nalang ang items. :)

Dim materials As Shape
Set materials = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=44, Top:=300, Width:=500, Height:=300)

Dim mats As String
Dim mats2 As String
Dim r As Integer
mats = ""
r = 24

Do
    mats = mats & exWb.Sheets(sSheetRef).Cells(r, 1) & vbTab & exWb.Sheets(sSheetRef).Cells(r, 3) & vbTab & vbTab & exWb.Sheets(sSheetRef).Cells(r, 5) & vbNewLine
    r = r + 1
Loop Until r = 42

materials.TextFrame.TextRange.Text = mats

materials.ThreeD.RotationX = 0
materials.ThreeD.RotationY = 0
materials.ThreeD.RotationZ = 2.4
With materials.Line
    .Visible = msoFalse
End With

Dim materials2 As Shape
Set materials2 = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=440, Top:=314, Width:=400, Height:=400)

r = 24

Do
    mats2 = mats2 & exWb.Sheets(sSheetRef).Cells(r, 15) & vbTab & vbTab & exWb.Sheets(sSheetRef).Cells(r, 17) & vbNewLine
    r = r + 1
Loop Until r = 42

materials2.TextFrame.TextRange.Text = mats2

materials2.ThreeD.RotationX = 0
materials2.ThreeD.RotationY = 0
materials2.ThreeD.RotationZ = 2.5
With materials2.Line
    .Visible = msoFalse
End With

Dim mattotal As Shape
Set mattotal = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=520, Top:=515, Width:=300, Height:=20)

mattotal.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(43, 17)
mattotal.ThreeD.RotationX = 0
mattotal.ThreeD.RotationY = 0
mattotal.ThreeD.RotationZ = 2

With mattotal.Line
    .Visible = msoFalse
End With

'merge labor number of days rate
Dim labor As Shape
Dim lab As String
Set labor = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=44, Top:=545, Width:=800, Height:=500)

r = 46

Do
    lab = lab & exWb.Sheets(sSheetRef).Cells(r, 1) & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & exWb.Sheets(sSheetRef).Cells(r, 5) & vbTab & vbTab & vbTab & vbTab & vbTab & exWb.Sheets(sSheetRef).Cells(r, 15) & vbTab & vbTab & exWb.Sheets(sSheetRef).Cells(r, 17) & vbNewLine
    r = r + 1
Loop Until r = 51

labor.TextFrame.TextRange.Text = lab
labor.ThreeD.RotationX = 0
labor.ThreeD.RotationY = 0
labor.ThreeD.RotationZ = 1.5
With labor.Line
    .Visible = msoFalse
End With

Dim labtotal As Shape
Set labtotal = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=525, Top:=625, Width:=300, Height:=20)

labtotal.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(52, 17)
labtotal.ThreeD.RotationX = 0
labtotal.ThreeD.RotationY = 0
labtotal.ThreeD.RotationZ = 2

With labtotal.Line
    .Visible = msoFalse
End With

Dim totalcost As Shape
Set totalcost = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=525, Top:=640, Width:=300, Height:=20)

totalcost.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(53, 17)
totalcost.ThreeD.RotationX = 0
totalcost.ThreeD.RotationY = 0
totalcost.ThreeD.RotationZ = 2

With totalcost.Line
    .Visible = msoFalse
End With

Dim preparedby As Shape
Set preparedby = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=225, Top:=680, Width:=300, Height:=20)
preparedby.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(57, 7)
preparedby.ThreeD.RotationX = 0
preparedby.ThreeD.RotationY = 0
preparedby.ThreeD.RotationZ = 2
With preparedby.Line
    .Visible = msoFalse
End With

Dim checkedby As Shape
Set checkedby = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=355, Top:=680, Width:=300, Height:=20)
checkedby.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(57, 12)
checkedby.ThreeD.RotationX = 0
checkedby.ThreeD.RotationY = 0
checkedby.ThreeD.RotationZ = 1
With checkedby.Line
    .Visible = msoFalse
End With

Dim approvedby As Shape
Set approvedby = ActiveDocument.Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=480, Top:=683, Width:=300, Height:=20)
approvedby.TextFrame.TextRange.Text = exWb.Sheets(sSheetRef).Cells(57, 16)
approvedby.ThreeD.RotationX = 0
approvedby.ThreeD.RotationY = 0
approvedby.ThreeD.RotationZ = 1

With approvedby.Line
    .Visible = msoFalse
End With

objExcel.Quit

Set exWb = Nothing

End Sub

    我知道，我知道，我的代码很讨厌，但这就是我现在所拥有的。抱歉。 ：）

1 个答案:

答案 0 :(得分：1)

您可以将所有代码存储在.xlam Excel插件中。

这意味着您不需要其他工作簿中的任何代码，只需将它们用于输入/输出即可。 这是一个详细的MSDN technical article，其中包含有关创建自己的插件的所有详细信息。如果那篇文章有点重，那么有许多other resources可以在线指导您。

如果确保加载插件，则可以通过其他工作簿访问插件工作簿的宏。有关这样做的详细信息，请参阅this Microsoft support link。

要考虑的一件事是将xlam文件设为只读（右键单击文件，属性，选中只读）。如果您在网络上共享xlam文件，这一点尤为重要。如果有人打开Excel并加载插件，则在Excel在其计算机上完全关闭之前，您将无法对其进行编辑。这在办公环境中可能会有问题。

为方便起见，addin应该在你的addins目录中，或者与使用它的工作簿相同的目录。

相关问题
最新问题