[编程交流] 将值保存到excel和bac

Public strTitleBlockName As String
Public MyTxtStr(0 To 7) As String
Public Cnt, WorkbookOpen, RowCnt As Integer
Public Excel As Excel.Application
Public ExcelSheet, ExcelWorkbook As Object
Public CurrRange As Range
Public myvaratt As Variant
Sub SaveCurrValues()
 If WorkbookOpen = 1 Then GoTo SkipCreatingWorkbook
 
   ' Launch Excel.
   
Set Excel = New Excel.Application
  
   ' Create a new workbook and find the active sheet.
  Set ExcelWorkbook = Excel.Workbooks.Add
   Set ExcelSheet = Excel.ActiveWorkbook.ActiveSheet
   
  ExcelWorkbook.SaveAs "AutoGlassCalcStoredValues.xls", True
  
Excel.Visible = False
 
RowCnt = 1
 
     With Worksheets("Sheet1")
   .Select
   .Range("a1").Activate
       End With
MyTxtStr(0) = XOffset
MyTxtStr(1) = YOffset
MyTxtStr(2) = ScrRef
MyTxtStr(3) = GlassSpec
MyTxtStr(4) = GlassColRef
MyTxtStr(5) = GlassRef
MyTxtStr(6) = TextHeight
MyTxtStr(7) = VPScale
   
SkipCreatingWorkbook:
Cnt = 3
   
    For I = 0 To Cnt
    
    
       Set CurrRange = ActiveCell
           CurrRange.Value = MyTxtStr(I)
               CurrRange.Offset(0, 1).Select
   
   Next
   
   RowCnt = RowCnt + 1
   
    With Worksheets("Sheet1")
   .Select
   .Range("a" & RowCnt).Activate
       End With
   
  WorkbookOpen = 1 'tell the sub that excel has already been opened
  
   ExcelWorkbook.Save
   ExcelWorkbook.Close
  ' Excel.Application.Quit
   'Excel.Application.
End Sub

Sub LoadCurrValues()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open("AutoGlassCalcStoredValues")
Set ExcelSheet = Excel.ActiveWorkbook.ActiveSheet
TxBxXOffset.Value = oWB.Range("a1").Value
TxBxYOffset.Value = Range("b1")
TxBxScrRef.Value = Range("c1")
TxBxSpec.Value = Range("d1")
CboGlsSpcCol.Value = Range("e1")
TxBxRef.Value = Range("f1")
TxBxTHght.Value = Range("g1")
TxBxVPScale.Value = Range("h1")
  
   ExcelWorkbook.Save
   ExcelWorkbook.Close
  ' Excel.Application.Quit
   'Excel.Application.
End Sub
cheers for any help!
col

Sub LoadCurrValues()
   Dim oExcel As Excel.Application
   Dim oWB As Workbook
   Set oExcel = New Excel.Application
   Set oWB = oExcel.Workbooks.Open("c:\Testing.xls")
   Set Excelsheet = Excel.ActiveWorkbook.ActiveSheet
   TxBxXOffset.Value = Excelsheet.Range("a1").Value
   TxBxYOffset.Value = Excelsheet.Range("b1").Value
   TxBxScrRef.Value = Excelsheet.Range("c1").Value
   TxBxSpec.Value = Excelsheet.Range("d1").Value
   CboGlsSpcCol.Value = Excelsheet.Range("e1").Value
   TxBxRef.Value = Excelsheet.Range("f1").Value
   TxBxTHght.Value = Excelsheet.Range("g1").Value
   TxBxVPScale.Value = Excelsheet.Range("h1").Value
   oWB.Save
   oExcel.Quit
End Sub

Sub LoadCurrValues()
Dim oExcel As Excel.Application
Dim oWB As Workbook
   Dim ExcelSheet As Object
   Dim ExcelWorkbook As Object
   On Error Resume Next
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open("AutoGlassCalcStoredValues")
oExcel.Visible = False
'Set ExcelSheet = Excel.ActiveSheet
'set oExcel.Range(a1).Value
UFcreateGlassAtt.TxBxXOffset.Value = oWB.ActiveSheet.Range("A1").Value
UFcreateGlassAtt.TxBxYOffset.Value = oWB.ActiveSheet.Range("B1").Value
UFcreateGlassAtt.TxBxScrRef.Value = oWB.ActiveSheet.Range("C1").Value
UFcreateGlassAtt.TxBxSpec.Value = oWB.ActiveSheet.Range("D1").Value
UFcreateGlassAtt.CboGlsSpcCol.Value = oWB.ActiveSheet.Range("E1").Value
UFcreateGlassAtt.TxBxRef.Value = oWB.ActiveSheet.Range("F1").Value
UFcreateGlassAtt.TxBxTHght.Value = oWB.ActiveSheet.Range("G1").Value
UFcreateGlassAtt.TxBxVPScale.Value = oWB.ActiveSheet.Range("H1").Value
  
   oWB.Save
   oWB.Close
   If Err Then Err.Clear
  ' Excel.Application.Quit
   'Excel.Application.
End Sub

Dim excelObj As Object
   
Set excelObj = CreateObject("excel.Application")
excelObj.Visible = True
   
excelObj.workbooks.Open ("c:\testing.xls")

Sub BringToLife()
On Error Resume Next
Dim e As Excel.Application
Set e = New Excel.Application
e.Visible = True
e.Workbooks.Add
e.Worksheets(“Sheet1”).Cells(4, 4).Value = 256
If Err Then MsgBox Error$
End Sub