怎么把一个上锁的excel题库转换成word？

1.打开excel文档，点击“文件”→“另存为web页”。 在“保存选项”处把“保存整个工作簿”调整为“选择：工作表”。把默认文件名"page.htm "根据实际情况改成所需要的名字，切记：在改名字时绝对不可以把后面的".htm"去掉，前面的部分就成。以图为例。

2.找到刚才保存好的工作表。

3.用word程序打开该文件后，直接点击“文件”→“另存为”，把文件名改成“工作表word版，把保存类型选成“word文档”，再点击“保存”即可。

EXCEL

Sub 批量打印()

Dim myFiles

Dim i As Long, j As Long

myFiles = Dir("C:\Users\Administrator\Desktop\1\*.xls") '路径自己改

On Error Resume Next

Application.ScreenUpdating = True

Application.DisplayAlerts = False

Do While myFiles <>""

i = i + 1

Workbooks.Open Filename:="C:\Users\Administrator\Desktop\1\" &myFiles

'以下 可以在多个文件执行各种统一命令

'

For j = 1 To Sheets.Count

Sheets(j).Select

ActiveWindow.View = xlPageBreakPreview

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _

IgnorePrintAreas:=False

Next

'ActiveWorkbook.Save

ActiveWindow.Close

myFiles = Dir

Loop

End Sub

WORD

Sub 批量打印() '打印选项为默认

Dim spath, sfile

Application.ScreenUpdating = False

spath = "C:\Documents and Settings\Administrator\桌面\121\" '路径自己改

sfile = Dir(spath &"*.doc")

While sfile <>""

With Documents.Open(spath &sfile)

Application.PrintOut fileName:="", Range:=wdPrintAllDocument, _

Item:=wdPrintDocumentWithMarkup, Copies:=1, Pages:="", _

PageType:=wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _

PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _

PrintZoomPaperHeight:=0

.Close

End With

sfile = Dir

Wend

End Sub

用vba编制程序来实现。

第一步：创建一个对照表，将excel表格的开始行号、结束行号、开始列号、结束列号以及word文档中表格的序号、开始行号、开始列号输入到对照表。

第二步：编制vba程序，读取对照表信息，根据对照表要求读取excel表格数据，写入到word的对应表格中。

下面是我曾经做过的例子，截取部分对照表信息以及部分程序代码供参考。

1、对照表截图

2、部分程序源码

Sub 导出数据()

S_EXCEL = Cells(4, 3).Text '数据源EXCEL文件名

T_WORD = Cells(7, 3).Text '目标WORD文档名

DZB = Cells(5, 3).Text '对照表工作表名

Call exc_to_word(S_EXCEL, T_WORD, DZB)

End Sub

Sub exc_to_word(S_EXCEL, T_WORD, DZB)

Dim wdoc As New Word.Application

Dim myPath As String

Dim XLAPP, MYS

Dim toolsB '工具工作簿

Dim I, J, K, L As Integer

Dim tableName As String

Dim exc_beginLine As Integer

Dim exc_endLine As Integer

Dim exc_beginColumn As Integer

Dim exc_endColumn As Integer

Dim wod_tableNumber As Integer

Dim wod_beginLine As Integer

Dim wod_beginColumn As Integer

Dim dataArr(1 To 500, 1 To 10)

Dim myDs '需要写入数据的WORD数据表

Dim XM(1 To 100)  '存放表格的项目名称

'myPath = "G:\EXCEL学习\猪八戒任务\EXCEL-TO-WORD\20151214\"

toolsB = ThisWorkbook.Name '保存当前工作簿名称

Windows(S_EXCEL).Activate

Set WB = ActiveWorkbook '数据源工作簿

Windows(toolsB).Activate

Set MYS = ActiveWorkbook.Sheets(DZB)

导出路径文件名 = ThisWorkbook.Path &"\" &T_WORD &".docx"

Set MYDOC = wdoc.Documents.Open(导出路径文件名)

wdoc.Visible = True

I = 2

Do While MYS.Cells(I, 1) >0

   tableName = MYS.Cells(I, 2)

   exc_beginLine = MYS.Cells(I, 3)

   exc_endLine = MYS.Cells(I, 9)

   exc_beginColumn = MYS.Cells(I, 4)

   exc_endColumn = MYS.Cells(I, 5)

   wod_tableNumber = MYS.Cells(I, 6)

   wod_beginLine = MYS.Cells(I, 7)

   wod_beginColumn = MYS.Cells(I, 8)

   WOD_FILENAME = MYS.Cells(I, 10)

   If WOD_FILENAME = T_WORD Then

      Set mYs2 = WB.Worksheets(tableName)

      For J = 1 To exc_endLine - exc_beginLine + 1

         XM(J) = mYs2.Cells(J + exc_beginLine - 1, 1)

         For K = 1 To exc_endColumn - exc_beginColumn + 1

             dataArr(J, K) = mYs2.Cells(J + exc_beginLine - 1, K + exc_beginColumn - 1)

         Next K

      Next J

      Set myDs = MYDOC.Tables(wod_tableNumber)

      L = myDs.Rows.Count '读取WORD表格行数

  '    If L - wod_beginLine + 1 <exc_endLine - exc_beginLine + 1 Then

       '  WORD表格插入行，使其同excel表格行数相同 一次插入多行没搞明白，故用此循环

      Do While L - wod_beginLine + 1 <exc_endLine - exc_beginLine + 1

         'Set myTable = ActiveDocument.Tables(1)

         'Set newrow = myTable.Rows.Add(BeforeRow:=myTable.Rows(1))

         'Set mylastrow = myDs.Rows.Last - 1 '从倒数第二行开始插入，以保持word格式的一致 走不通！

         Set mylastrow = myDs.Rows.Last

         myDs.Rows.Add mylastrow

         L = myDs.Rows.Count '读取WORD表格行数

         

      Loop

        ' myDs.Rows.Add (exc_endLine - exc_beginLine + 1) - (L - wod_beginLine + 1)

        ' myDs.Cell(Row:=L - wod_beginLine + 1, Column:=wod_beginColumn).Select

        ' Selection.InsertRowsBelow (exc_endLine - exc_beginLine + 1) - (L - wod_beginLine + 1)

         For J = 1 To exc_endLine - exc_beginLine + 1

            myDs.Cell(Row:=wod_beginLine + J - 1, Column:=1).Range = XM(J)

         Next J

   '   End If

      For J = 1 To exc_endLine - exc_beginLine + 1

         For K = 1 To exc_endColumn - exc_beginColumn + 1

            If Not IsError(dataArr(J, K)) Then

            myDs.Cell(Row:=wod_beginLine + J - 1, Column:=wod_beginColumn + K - 1).Range.Text = VBA.Format$(dataArr(J, K), "#,###.00")

            End If

         Next K

      Next J

   End If

   I = I + 1

Loop

MYDOC.Save

MYDOC.Close False  '关闭word文档

Set MYDOC = Nothing    '清空工作簿项目

End Sub

---