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

问题描述 投票:1回答:1

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

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

工作簿SRJem.xlsx是一个文件,其中所有输入都进入(通常我从我们的保管人的手动输入粘贴),然后由Service Report Printer.docx中的MS Word宏复制以立即打印(因为形式是如此扭曲,我不得不这样编码)。此外,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

我知道,我知道,我的代码很讨厌,但这就是我现在所拥有的。抱歉。 :)

vba excel-vba ms-word excel
1个回答
© www.soinside.com 2019 - 2024. All rights reserved.