如何在VB中操作EXCEL(一段代码,两个可以使用的过程)

工程引用说明:本代码的使用是基于Microsoft Excel 2003使用的,未在其它版本的Office上测试过,因此在VB中应当引用Microsoft Excel 11.0
代码其它内容说明:本代码中使用了VsFlexGrid做为源数据;并且可以命名EXCEL 工作单(SHEET)的名称,其中第一段代码是将内容保存到一个新的EXCEL 工作簿中,而第二个则是将内容保存到一个已存在的工作簿中。

为了显示进度,我使用了一个显示进度的窗体,frmPBar,可以去掉相关的该段代码。

Public Sub GridToExcel(srcGrid As VSFlexGrid, shName As String)
    '将Grid中的数据导出到Excel表格中
    Dim i As Integer
    Dim j As Integer
   
    Dim appXL As Variant
    Dim wb As Excel.Workbook
    Dim sh As Excel.Worksheet
    Dim rng, rng1, rng2 As Excel.Range
   
    On Error GoTo errhandler
   
    Set appXL = CreateObject("Excel.Application")
    Set wb = appXL.Workbooks.Add()
   
    wb.Activate
   
    Set sh = wb.Worksheets.Add()
    sh.Name = shName
   
    frmPBar.Caption = "正在导出数据,请稍候......"
    frmPBar.Show
   
    For i = 0 To srcGrid.Rows - 1
        For j = 1 To srcGrid.Cols - 1
            sh.Cells(i + 1, j) = srcGrid.Cell(flexcpText, i, j)
            DoEvents
        Next j
    Next i
   
    Unload frmPBar
       
    appXL.Visible = True
    Exit Sub
errhandler:
    MsgBox Err.Description
   
End Sub


Public Sub GridToExistExcel(srcGrid As VSFlexGrid, fileName As String, shName As String)
    '将Grid中的数据导出到一个指定文件的Excel表格中
    Dim i As Integer
    Dim j As Integer
   
    Dim appXL As Variant
    Dim wb As Excel.Workbook
    Dim sh As Excel.Worksheet
    Dim rng, rng1, rng2 As Excel.Range
   
    On Error GoTo errhandler
   
    Set appXL = CreateObject("Excel.Application")
    'Set wb = appXL.Workbooks.Add()
    Set wb = appXL.Workbooks.Open(fileName)
    wb.Activate
   
    Set sh = wb.Worksheets.Add()
    sh.Name = shName
   
    frmPBar.Caption = "正在导出数据,请稍候......"
    frmPBar.Show
    For i = 0 To srcGrid.Rows - 1
        For j = 1 To srcGrid.Cols - 1
            sh.Cells(i + 1, j) = srcGrid.Cell(flexcpText, i, j)
            DoEvents
        Next j
    Next i
    Unload frmPBar
   
    appXL.Visible = True
    Exit Sub
errhandler:
    MsgBox Err.Description
   
End Sub

### 回答1: 这是一个很有趣的问题!我可以提供一个简单的示例代码:Sub DrawHeart() Dim x As Integer, y As Integer For x = 0 To 200 Step 20 For y = 0 To 200 Step 20 ActiveSheet.Shapes.AddShape(msoShapeHeart, x, y, 20, 20).Select Next y Next x End Sub ### 回答2: 在Excel使用VB语言来绘制一个心形图形的代码如下: ```vb Sub DrawHeartShape() Dim i As Double Dim x As Double Dim y As Double Dim HeartShape As Shape Dim HeartWidth As Double Dim HeartHeight As Double ' 设置画布大小 With ActiveSheet .Columns(1).ColumnWidth = 10 .Rows(1).RowHeight = 20 End With ' 设置心形的宽高 HeartWidth = 8 HeartHeight = 10 ' 清除之前的图形 For Each HeartShape In ActiveSheet.Shapes If HeartShape.Name Like "Heart*" Then HeartShape.Delete End If Next HeartShape ' 绘制心形 For i = -1 To 1 Step 0.01 x = HeartWidth * (16 * Sin(i) ^ 3) + 0.5 y = -HeartHeight * (13 * Cos(i) - 5 * Cos(2 * i) - 2 * Cos(3 * i) - Cos(4 * i)) + 0.5 ' 绘制单个心形点 With ActiveSheet .Shapes.AddShape(msoShapeOval, x, y, 1, 1).Name = "Heart" & i .Shapes("Heart" & i).Fill.ForeColor.RGB = RGB(255, 0, 0) ' 设置填充颜色为红色 End With Next i End Sub ``` 在运行这段代码后,会在Excel表格生成一个心形图形。代码使用心形的参数方程绘制每个点,然后用椭圆形状填充来表示心形的轮廓。通过修改代码的参数,还可以调整心形的大小和形状。 ### 回答3: 在Excel使用VBA语言编写画心形的代码实现如下: Sub DrawHeartShape() Dim ws As Worksheet Dim i As Integer, j As Integer Set ws = ActiveSheet For i = -4 To 4 For j = -4 To 4 If Abs(i) + Abs(j) < 5 Then ws.Cells(i + 5, j + 6).Value = "❤️" Else ws.Cells(i + 5, j + 6).Value = "" End If Next j Next i For i = -4 To 4 For j = -4 To 4 If (Abs(j) <= 0.85 * Abs(i)) And (Abs(i) < 4.5) Then ws.Cells(i + 13, j + 6).Value = "❤️" Else ws.Cells(i + 13, j + 6).Value = "" End If Next j Next i End Sub 此代码,首先定义了一个工作表对象ws,用于表示当前活动工作表。然后使用嵌套的循环来遍历每一个细胞,并根据坐标位置来判断是否需要在该细胞绘制心形符号"❤️"。通过计算坐标位置的绝对值之和是否小于5,即可确定是否在该细胞绘制心形符号。 接下来的嵌套循环用于绘制心形的两侧。由于心形是一个左右对称的图形,所以只需判断一个侧面,然后通过设置不同的坐标偏移来实现对称。使用i和j的关系(i代表行坐标,j代表列坐标)来判断是否需要在该细胞绘制心形符号,可以获得一个比较接近真实心形形状的效果。 最后,在具体的细胞位置上写入"❤️"即可。这里通过相对行列坐标来计算实际的细胞位置,并将"❤️"字符赋值给该细胞。 使用以上代码,即可在Excel绘制出一个近似的心形图案。请注意,该代码是在活动工作绘制,所以请确保Excel至少有一个工作表处于活动状态。
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值