

                         VBForums -    ̳ 


                         .       
               


         VBForums-̳: HTTP://hzsoft.yeah.net
            
                  ύʼ: VBForums@usa.net?Subject=VBForums

            нϵ: ympang@bigfoot.com



:
    vbӶ˿ڣӡڣһֽڡлл
                            - zhengyi@public.guangzhou.gd.cn

:
    Prisonerwww.datadynamics.com ϼAcrivebar     
    1.038棬֪ɷһݸңлл
                                    - ֳ
                                    - mail: einolda@mail.sc.cninfo.net

:
    ܷ񿪸ѧ̳һһĽЩϽꡣ飬
    Чãֻкǲ̺ܽҡʲôʱ֪ͨһ
                                    - mxia@163.net

:
    richtextboxؼУùһƪֺ󣬳к
    һֲֵɼVB֣ʱʹÿؼıı
    ԶУлл

                                - !!!!
1:
    иMultilineΪTRUEԽ
                             - gui
2
    RICHTEXTBOXؼұ߾һ£ɽ»С
                             - donald

    ӦĻӦ:
        richtextboxؼУùһƪֺ󣬳к
        һֲֵɼVB֣ʱʹÿؼıı
        ԶУлл

                                - !!!!
                                        MutilineΪTRUE
------------------------------------------------------------------------
:
    λáWindowsҼ˵мԼ
    磬ĳһļĳһļĹ˵мĳ򿪵
    лл    ⣬Լдĳм룬ʹøó Windows
    ʱԶУעrunмӦĿлл
                             - Prisoner
------------------------------------------------------------------------
:
    λ֣
         VBѧߣ볢VB5.0+ACCESS97дһ֧Ʊӡ.
    һ:νİתĽд,"123.00"ת
    "Ҽ۷ʰԪ"?
         ⻹һЩ,ϣλEMAILҽû
    ҪĳķܹҲο
                     ʤм
                                - sya
------------------------------------------------------------------------
------------------------------------------------------------------------
ѡ

                 OLE     ACESS97    
            
                 ֱ      ˳   ȱ  
    
              ͨ        Ժ      

         ACCESS97  һ           ,                    , Ҳ  һ   Client/Server  Ʒ    ǰ     .       ѧ  á       д            ʱ             ǿ   ϵ ͳ                   ʹ  ʱ           һ            ȱ ݣ       DETAIL         Ϊ         Ϊ     ˳ ӣCan Grow   ΪTrue ʱ        ߣ             ߣ       У         һ    ˳ ӡ ʹ          ۡ   ȱ  ACCESS2.0 ACCESS97      ,  FoxPro2.5B/3.0/5.0  ȴ û С  ΢           Ա ˵       ʱ     ԭ   ¡ Ϊ ˣ   ACCESS    OLE   !
  ACCESS97  ѯ      EXCEL97        ܡ  ӡ Ԥ ݣ          ⡣  ACCESS97 EXCEL97 VBA 97       ȫ  ݣ EXCEL97  ¼      ֻ  ACCESS        ˣ                      ʱ    ࡣ      Ҫ     

EXCEL97         ʽ    ͷ ҳ ü ҳ  ȣ   Ҫ    ת  У "  Ԫ   ʽ  "   Ϊ"    " 

EXCEL97  ¼              ꣨     ܡ    ߣ   С  ӡ   Ԥ     

ACCESS  VBA   DAO          EXCEL  ڣ  EXCEL      ACCESS    䡣 
           ACCESS97      룬 ʵ  Ӧ       һ      Ļ(FORM),        (Comb_)  һ    Text,    ѡ   Ӧ   Ϣ Ȼ    " ȷ "    ť ִ       Щ      ACCESS2.0    ʹ ,     Ӧ   . 
  Private Sub ȷ _Click()
  On Error GoTo ErrorHandler
  Dim stDocName As String
  Dim k As Integer
  stDocName = "Pqry_YEAR"
         DoCmd.OpenQuery stDocName '  ԭ ʼ           Ϣ    "     ѯ",   һ    ӡ   . 
         '     ¼  -- Ϊ   ֤  ¼   ʱ Ҳ  ӡ   . 

         If Val(Me![Comb  ]) > 0 Then '         0   ֵ,  ʾ    

     For k = 1 To Val(Me![Comb  ])
       CurrentDb.Execute "INSERT INTO Pqry_YEAR
      (  Ŀ ) VALUES ('      ');"
     Next k
  End If
  Dim msgVar As Integer  
  '  EXCEL    
  '------------------------------
  Dim xlobj As Object
  Dim xlsheetobj As Object
  Dim xlrange As Object
  '------------------------------
  '  ACESS  ¼     
  Dim dbs As Database, rst As Recordset
  Dim strSQL As String
  Dim recTotal, fieldTotal As Integer ' recTotal:
           ʾ     ¼  ; 
          fieldTotal  ʾ    
  Dim i, j As Integer
  i = 0
  j = 0
  ' Return reference to current database.
  Set dbs = CurrentDb '  ǰ   
  Set rst = dbs.OpenRecordset("Pqry_YEAR ") ' ѡ   ¼ 
  recTotal = rst.RecordCount '    ¼ 
  fieldTotal = rst.Fields.Count  '     
  '----------------------------------
  '  EXCEL  
  Set xlobj = CreateObject("Excel.Application.8")
  '      EXCEL --REPORT.XLS
  xlobj.Workbooks.Open FileName:=pPathname & " REPORT.xls"
  Set xlsheetobj = xlobj.ActiveWorkbook.Worksheets("REPORT ") 
   ' ָ    
  '        ,    
  If MsgBox("  ǰ  ӡ         , 
      Ҫ  ?" 
   & Chr(13) & _
   "  ʾ: ֻ         ,   Ҫ  .", 68)
    = vbYes Then
DoCmd.Hourglass True  '   ʱ   , 
    Ϊ ɳ ©  ״
    xlsheetobj.Rows("5:200").Select  ' ѡ   
xlobj.Selection.Delete Shift:=-4162  '
         ע ! ԭ ¼   -4162 Ϊxlnone, EXCEL97   ,  ACCESS  ȴ  , ֻ  EXCEL        ȥ  ѯ  Ӧ   . 
    '  ʼ EXCEL    
    Do Until rst.EOF
      For j = 1 To fieldTotal
          xlsheetobj.cells(5 + i, j).Value = rst.Fields(j - 1)
      Next j
      rst.MoveNext
      i = i + 1
    Loop
    rst.Close
  
   'EXCELе,峣μEXCELµĶ
xlsheetobj.Range("A4:Q" & Trim(Str(recTotal + 4))).
    Select ' ѡ   Χ
   'Ϊñ߿¼Ƶĺ,ɾƵ.
    xlobj.Selection.Borders(5).LineStyle = -4142
    xlobj.Selection.Borders(6).LineStyle = -4142
    With xlobj.Selection.Borders(7)
        .LineStyle = 1
        .Weight = -4138
        .ColorIndex = -4105
    End With
    
    With xlobj.Selection
    ' ȷ            β
      If Me![Fram λ ] = 1 Then
         .Subtotal GroupBy:=2, Function:=-4157,
           TotalList:=Array(6, 9, 10, _
           11, 12, 13, 14, 15, 16), Replace:=True,
           PageBreaks:=False, _
           SummaryBelowData:=False
      Else
         .Subtotal GroupBy:=2, Function:=-4157,
          TotalList:=Array
          (6, 9, 10, _
           11, 12, 13, 14, 15, 16), Replace:=True,
           PageBreaks:=False, _
           SummaryBelowData:=True
      End If
    End With
    '      ѡ    ҳ ü  ҳ β
    With xlsheetobj.PageSetup
        .LeftHeader = "" & Chr(10) & "" & Chr(10) & "
        " & Mid(Me![Cmbo  λ], 4)
        .CenterHeader = "&""  ,  ""&18 " & Me!
        [Cmbo  ] & " " & Mid(Me![Cmbo  ], 4) & "XXX "
    End With
    xlsheetobj.Range("A1").Select
    '       
    k = Val(Me![Comb  ])
    If Val(Me![Comb  ]) > 0 Then
       Dim content As String
       i = 5
       content = xlsheetobj.cells(i, 2).formulaR1C1
       Do While InStr(1, content, "      ") = 0
           i = i + 1
           content = xlsheetobj.cells(i, 2).formulaR1C1
       Loop
       xlsheetobj.Range("B" & Trim(Str(i - k + 5)) & ":" & "Q" 
       & Trim(Str(i + 5))).Select
       xlobj.Selection.ClearContents 
       xlsheetobj.Range("A1").Select
    End If
    
Else  '   
    xlsheetobj.Activate
End If
xlobj.ActiveWindow.SelectedSheets.PrintPreview  ' Ԥ   
'  Ϊ  ӡxlobj.ActiveWindow.SelectedSheets.PrintOut
DoCmd.Hourglass False '      ״
xlobj.Visible = True  ' EXCEL  
       䣬  ʡ  
Set dbs = Nothing
Set xlobj = Nothing
xlobj.quit  '  EXCEL
Exit Sub
ErrorHandler:  '    
  DoCmd.Hourglass False
  MsgBox "Error number " & Err.Number & ": " & Err.Description
    ' Resume with statement following occurrence of error.
    Resume Next
End Sub
         ͨ          OFFICE97   OLE     չ Ӧ         ô    ǿ  EXCEL           ʽ  ,    . ȱ    һ   EXCEL   ʱ    . 
            EXCEL         ,  ʵ Ҳ         EXCEL    ͼ  ͳ ơ       ͸      Ӧ    ֻ Ҫ EXCEL  ¼   Ӧ  ꣬   ACCESS    ˡ 

   

й˾Ȩ 


˶ http://server.com/WebApps/mail-list-unsubscribe.cgi?id=4093


