如何将网页数据到入EXCEL里面

最新推荐文章于 2024-02-20 14:06:50 发布

gengwei80

最新推荐文章于 2024-02-20 14:06:50 发布

阅读量1.4k

点赞数

CC 4.0 BY-SA版权

文章标签： excel c

本文链接：https://blog.youkuaiyun.com/gengwei80/article/details/114330

这段代码展示了如何在VBA中创建一个Excel应用程序实例，将网页表格数据导入到Excel工作表中，并进行格式设置。通过设置单元格字体、边框样式、对齐方式等，实现数据的美观展示。同时，代码还设置了页眉和页脚信息，以及保存Excel文件。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

sub btnExport_onclick()
' alert(document.all.mytable.rows(0).cells.length)
dim objExcel
on error resume next
CreateFolder()
DeleteFile("C:/Report/"&document.all.info.value&".xls")
Set objExcel = CreateObject("excel.application")
   With objExcel
    .visible =true
    .workbooks.add
    .sheets("sheet1").select

   End with
   m_row="0"

   With objExcel.ActiveWorkBook.Sheets(1)
                              .Range(.Cells(1, 1), .Cells(1, document.all.mytable.cells.length)).Font.Name = "宋体"
                                    '设标题为黑体字
                              .Range(.Cells(1, 1), .Cells(1, document.all.mytable.cells.length)).Font.Bold = True
                                    '标题字体加粗
                              .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).Borders.LineStyle = 1
                                       '设表格边框样式
         .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).Font.Name = "宋体"
         .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).Font.Size = "9"
         .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).WrapText = True
         .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).HorizontalAlignment = xlCenter
                              .Range(.Cells(1, 1), .Cells(document.all.mytable.rows.length, document.all.mytable.rows(0).cells.length)).ShrinkToFit = True

End With

                        With objExcel.ActiveWorkBook.Sheets(1).PageSetup
                             .LeftHeader = "" & Chr(10) & "&""宋体,常规""&10业务模块：" & document.all.info.value
                             .CenterHeader = "&""宋体,粗体""巢湖配电地理信息系统"
                             .RightHeader = "" & Chr(10) & "&""宋体,常规""&10打印日期："&now()
                             .LeftFooter = "&""宋体,常规""&10制表人："
                             .CenterFooter = "&""宋体,常规""&10制表日期："
                          '   .RightFooter = "&""宋体,常规""&10第&P页共&N页"
                        End With
   'objExcel.Cells(2,2).Value=document.all.info.value

   'objExcel.Cells(3,2).Value="打印时间："&now()
       for a=0 to document.all.mytable.rows.length-1
          m_row = cstr(int (m_row)+1)
         for b=0 to document.all.mytable.rows(a).cells.length-1
               m_col = chr(asc("A")+b)
        'alert(document.all.mytable.rows(0).Cells(m_col).Width)
        'objexcel.Columns(m_col).ColumnWidth=document.all.mytable.rows(0).Cells(m_col).Width
               objexcel.range(m_col&m_row).select
               M_value = (document.all.mytable.rows(a).cells(b).innerText)
      objexcel.activecell.value=cstr(m_value)
      next
       next
   objexcel.visible=true
   objexcel.range("A1").select
   objExcel.ActiveWorkBook.SaveAs "C:/Report/"&document.all.info.value&".xls"
                        'DeleteFile("C:/Report/"&document.all.info.value&".xls")

End sub
sub SetStyle(Obj)
    With Obj.ActiveWorkBook.Sheets(1)
       .Range(.Cells(1, 1), .Cells(1, 4)).Font.Name = "宋体"
       .Range(.Cells(1, 1), .Cells(1, 4)).Font.Bold = True
       .Range(.Cells(1, 1), .Cells(1, 4)).MergeCells = True
       .Range(.Cells(3, 2), .Cells(3, 4)).MergeCells = True
       .Range(.Cells(4, 2), .Cells(4, 4)).MergeCells = True
       .Range(.Cells(5, 2), .Cells(5, 4)).MergeCells = True
       .Range(.Cells(8, 2), .Cells(8, 4)).MergeCells = True
       .Range(.Cells(2, 1), .Cells(9, 4)).Borders.LineStyle = 1
       if document.getElementById("reportstyle").value <> "" then
        .Range(.Cells(11, 2), .Cells(11, 4)).MergeCells = True
        .Range(.Cells(12, 2), .Cells(12, 4)).MergeCells = True
        .Range(.Cells(11, 1), .Cells(15, 4)).Borders.LineStyle = 1
         if document.getElementById("reportstyle1").value <> "" then
         .Range(.Cells(17, 2), .Cells(17, 4)).MergeCells = True
         .Range(.Cells(18, 2), .Cells(18, 4)).MergeCells = True
         .Range(.Cells(17, 1), .Cells(19, 4)).Borders.LineStyle = 1
         if document.getElementById("reportstyle2").value <> "" then
         .Range(.Cells(21, 2), .Cells(21, 4)).MergeCells = True
         .Range(.Cells(22, 2), .Cells(22, 4)).MergeCells = True
         .Range(.Cells(21, 1), .Cells(24, 4)).Borders.LineStyle = 1
         if document.getElementById("reportstyle3").value <> "" then
         .Range(.Cells(26, 2), .Cells(26, 4)).MergeCells = True
         .Range(.Cells(26, 1), .Cells(27, 4)).Borders.LineStyle = 1
         end if
        end if
       end if
       end if
       .Range(.Cells(2, 1), .Cells(4, 4)).Font.Name = "宋体"
       .Range(.Cells(1, 1), .Cells(1, 4)).Font.Size = "12"
       .Range(.Cells(2, 1), .Cells(31, 4)).Font.Size = "9"
       .Range(.Cells(2, 1), .Cells(4, 4)).WrapText = True
       .Range(.Cells(2, 1), .Cells(8, 8)).ShrinkToFit = True
       objExcelSheet.Rows(5).RowHeight=30
       objExcelSheet.Columns(1).ColumnWidth = 18
        End With

end sub