将Excel单元格数据写入Word文档不一致

4bbkushb  于 2023-11-20  发布在  其他
关注(0)|答案(1)|浏览(121)

下面是我的Word模板,我的代码,和我的输出。我的问题是,有些输出行是正确的,而有些不是。我做错了什么?
以下是我的Word模板:

  1. [Art Source]
  2. [Day]
  3. [Scripture]
  4. [Title], [Created]
  5. [Creator], [Country], [Life]
  6. [Medium], [Size]
  7. [Location], [City]

字符串
以下是我的验证码:

  1. Option Explicit
  2. Sub Create_Art_Doc()
  3. Dim wApp As Word.Application
  4. Dim wDoc As Word.Document
  5. Dim folder As FileDialog
  6. Dim path As String
  7. Dim sht As String
  8. Dim r As Long
  9. r = InputBox("Enter sequence number")
  10. r = r + 1
  11. Set folder = Application.FileDialog(msoFileDialogFolderPicker)
  12. folder.AllowMultiSelect = False
  13. If folder.Show = -1 Then
  14. path = folder.SelectedItems(1)
  15. End If
  16. If path = "" Then Exit Sub
  17. If Right(path, 1) <> "\" Then path = path & "\Art + Doc"
  18. Set wApp = CreateObject("Word.Application")
  19. wApp.Visible = True
  20. sht = "Details - Year B - 2023-2024"
  21. Set wDoc = wApp.Documents.Open(Filename:="G:\ArtDoc Master.dotx", ReadOnly:=True)
  22. With wDoc.Application
  23. .Selection.Find.Text = "[Art_Source]"
  24. .Selection.Find.Execute
  25. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("S"))
  26. .Selection.EndOf
  27. .Selection.Find.Text = "[Day]"
  28. .Selection.Find.Execute
  29. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("B"))
  30. .Selection.EndOf
  31. .Selection.Find.Text = "[Scripture]"
  32. .Selection.Find.Execute
  33. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("G"))
  34. .Selection.EndOf
  35. .Selection.Find.Text = "[Title]"
  36. .Selection.Find.Execute
  37. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("H"))
  38. .Selection.EndOf
  39. .Selection.Find.Text = "[Created]"
  40. .Selection.Find.Execute
  41. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("I"))
  42. .Selection.EndOf
  43. .Selection.Find.Text = "[Medium]"
  44. .Selection.Find.Execute
  45. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("J"))
  46. .Selection.EndOf
  47. .Selection.Find.Text = "[Size]"
  48. .Selection.Find.Execute
  49. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("K"))
  50. .Selection.EndOf
  51. .Selection.Find.Text = "[Creator]"
  52. .Selection.Find.Execute
  53. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("L"))
  54. .Selection.EndOf
  55. .Selection.Find.Text = "[Country]"
  56. .Selection.Find.Execute
  57. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("N"))
  58. .Selection.EndOf
  59. .Selection.Find.Text = "[Life]"
  60. .Selection.Find.Execute
  61. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("M"))
  62. .Selection.EndOf
  63. .Selection.Find.Text = "[Location]"
  64. .Selection.Find.Execute
  65. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("P"))
  66. .Selection.EndOf
  67. .Selection.Find.Text = "[City]"
  68. .Selection.Find.Execute
  69. .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("Q"))
  70. .Selection.EndOf
  71. End With
  72. wDoc.SaveAs2 Filename:=path, FileFormat:=wdFormatXMLDocument
  73. ' Close the Word document and the Word application
  74. wDoc.Close
  75. wApp.Quit
  76. ' Clean up
  77. Set wDoc = Nothing
  78. Set wApp = Nothing
  79. MsgBox "Art + Doc written to: " & path
  80. End Sub
  81. Function ColAlphaToNum(c As String)
  82. ColAlphaToNum = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", c)
  83. End Function


这是我的输出:

  1. https://stregischurch.com/confirmation[Art Source]
  2. Third Sunday of Advent
  3. Isaiah 61:1-4, 8-11
  4. The Dove of the Holy Spirit, 1666
  5. [Creator], [Country], [Life]
  6. Stained glass, naGian Lorenzo BerniniItalian1598 - 1680
  7. Throne of St. Peter, St. Peter's Basilica, The Vatican


其中的错误:

  • [Art Source]位于第一行的末尾
  • 5号线[Creator]
  • 艺术家的姓名、国籍和生平在第6行,本应填写在第5行

注:第六行的'na'是正确的

idv4meu8

idv4meu81#

在选择文档内容时出现了一些小问题。

  1. Option Explicit
  2. Sub Create_Art_Doc()
  3. Dim wApp As Word.Application
  4. Dim wDoc As Word.Document
  5. Dim folder As FileDialog
  6. Dim path As String
  7. Dim sht As String
  8. Dim r As Long
  9. r = InputBox("Enter sequence number")
  10. r = r + 1
  11. Set folder = Application.FileDialog(msoFileDialogFolderPicker)
  12. folder.AllowMultiSelect = False
  13. If folder.Show = -1 Then
  14. path = folder.SelectedItems(1)
  15. End If
  16. If path = "" Then Exit Sub
  17. If Right(path, 1) <> "\" Then path = path & "\Art + Doc"
  18. Set wApp = CreateObject("Word.Application")
  19. wApp.Visible = True
  20. sht = "Details - Year B - 2023-2024"
  21. Set wDoc = wApp.Documents.Open(Filename:="G:\ArtDoc Master.dotx", ReadOnly:=True)
  22. wDoc.Select
  23. With wApp.Selection.Find
  24. .Text = "[Art Source]"
  25. .Execute replacewith:=Worksheets(sht).Cells(r, "S")
  26. '.Selection.EndOf
  27. wDoc.Select
  28. .Text = "[Day]"
  29. .Execute replacewith:=Worksheets(sht).Cells(r, "B")
  30. '.Selection.EndOf
  31. wDoc.Select
  32. .Text = "[Scripture]"
  33. .Execute replacewith:=Worksheets(sht).Cells(r, "G")
  34. ' .Selection.EndOf
  35. wDoc.Select
  36. .Text = "[Title]"
  37. .Execute replacewith:=Worksheets(sht).Cells(r, "H")
  38. '.Selection.EndOf
  39. wDoc.Select
  40. .Text = "[Created]"
  41. .Execute replacewith:=Worksheets(sht).Cells(r, "I")
  42. '.Selection.EndOf
  43. wDoc.Select
  44. .Text = "[Medium]"
  45. .Execute replacewith:=Worksheets(sht).Cells(r, "J")
  46. '.Selection.EndOf
  47. wDoc.Select
  48. .Text = "[Size]"
  49. .Execute replacewith:=Worksheets(sht).Cells(r, "K")
  50. '.Selection.EndOf
  51. wDoc.Select
  52. .Text = "[Creator]"
  53. .Execute replacewith:=Worksheets(sht).Cells(r, "L")
  54. '.Selection.EndOf
  55. wDoc.Select
  56. .Text = "[Country]"
  57. .Execute replacewith:=Worksheets(sht).Cells(r, "N")
  58. '.Selection.EndOf
  59. wDoc.Select
  60. .Text = "[Life]"
  61. .Execute replacewith:=Worksheets(sht).Cells(r, "M")
  62. '.Selection.EndOf
  63. wDoc.Select
  64. .Text = "[Location]"
  65. .Execute replacewith:=Worksheets(sht).Cells(r, "P")
  66. '.Selection.EndOf
  67. wDoc.Select
  68. .Text = "[City]"
  69. .Execute replacewith:=Worksheets(sht).Cells(r, "Q")
  70. '.Selection.EndOf
  71. End With
  72. wDoc.SaveAs2 Filename:=path, FileFormat:=wdFormatXMLDocument
  73. ' Close the Word document and the Word application
  74. wDoc.Close
  75. wApp.Quit
  76. ' Clean up
  77. Set wDoc = Nothing
  78. Set wApp = Nothing
  79. MsgBox "Art + Doc written to: " & path
  80. End Sub
  81. Function ColAlphaToNum(c As String)
  82. ColAlphaToNum = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", c)
  83. End Function

字符串

展开查看全部

相关问题