exporter formatteret til Excel

i toppen tilføjes:

  Dim MyXL As Object

derefter indsættes mellem de 2 gange ...

        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, rs2!branchNr, \"c:\\top10\\Branch no_\" & rs2!branchNr & \".xls\", True, \"\"
...
  Set MyXL = New Excel.Application
  MyXL.Workbooks.Open \"c:\\top10\\Branch no_\" & rs2!branchNr & \".xls\"
  With MyXL.Application
    .Cells.Select
    .Selection.Font.Size = 7
    .Cells.EntireColumn.AutoFit
    .Range(\"A1\").Select
    .Save
    .Quit
  End With
  Set MyXL = Nothing
...
db.QueryDefs.Refresh


Du skal huske at oprette en reference til Excel97

Samtidig må jeg indskyde at det kan være at der er en bedre måde at gøre dette på, og at det ikke er perfekt, men det burde virke...

Thats how would have done it too proacess,
maybe would change Dim MyXL As Object to Dim MyXL As Excel.Application but otherwise it does the trick!

øhhh vil du være så sød og rar at skrive det komplette script med din tilføjelse...

jeg er alvorlig bange for at jeg laver kongelig ged i det ellers....!!!!

Jeg er jo ikke overhovedet ekspert i VBA men forsøger at tyde og lære...

Private Sub Command51_Click()
Dim MyXL As Object
If Dir(\"C:\\Top10\", vbDirectory) = \"\" Then
  MkDir \"C:\\Top10\"
  Else
    End If
Me.Text53.Visible = True
Me.Repaint
Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset(\"tblBranch\")

DoCmd.SetWarnings False

DoCmd.RunSQL \"Delete * from top10\"

Do While Not rs.EOF

DoCmd.RunSQL \"INSERT INTO top10 SELECT TOP 10 [gr all down].* FROM [gr all down] WHERE [gr all down].[branch nr] = \'\" & rs!branchNr & \"\'\"
DoCmd.RunSQL \"INSERT INTO top10 SELECT TOP 10 [0-sale 3mth_gr all].* FROM [0-sale 3mth_gr all] WHERE [0-sale 3mth_gr all].[branch nr] = \'\" & rs!branchNr & \"\'\"
DoCmd.RunSQL \"INSERT INTO top10 SELECT TOP 10 [0-sale 6mth_gr all].* FROM [0-sale 6mth_gr all] WHERE [0-sale 6mth_gr all].[branch nr] = \'\" & rs!branchNr & \"\'\"
DoCmd.RunSQL \"INSERT INTO top10 SELECT TOP 10 [all group stock greater 3 mth sale].* FROM [all group stock greater 3 mth sale] WHERE [all group stock greater 3 mth sale].[branch nr] = \'\" & rs!branchNr & \"\'\"
DoCmd.RunSQL \"INSERT INTO top10 SELECT TOP 10 [all group stock greater 6 mth sale].* FROM [all group stock greater 6 mth sale] WHERE [all group stock greater 6 mth sale].[branch nr] = \'\" & rs!branchNr & \"\'\"

rs.MoveNext
       
Loop

Dim rs2 As Recordset
Dim sSQL As String
Dim MyQry As QueryDef

    Set db = CurrentDb
    Set rs = Nothing
    Set rs2 = db.OpenRecordset(\"tblBranch\")
rs2.MoveFirst
   
    Do While Not rs2.EOF
           
        sSQL = \"SELECT [Qtop10].* FROM [Qtop10] WHERE [Qtop10].[branch nr] = \'\" & rs2!branchNr & \"\'\"

        \'Create a new querydef
        Set MyQry = db.CreateQueryDef(rs2!branchNr)
        MyQry.SQL = sSQL
       
        MyQry.Close
       
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, rs2!branchNr, \"c:\\top10\\Branch no_\" & rs2!branchNr & \".xls\", True, \"\"
  Set MyXL = New Excel.Application
  MyXL.Workbooks.Open \"c:\\top10\\Branch no_\" & rs2!branchNr & \".xls\"
  With MyXL.Application
    .Cells.Select
    .Selection.Font.Size = 7
    .Cells.EntireColumn.AutoFit
    .Range(\"A1\").Select
    .Save
    .Quit
  End With
  Set MyXL = Nothing
       
        db.QueryDefs.Refresh
        db.QueryDefs.Delete rs2!branchNr
           
        rs2.MoveNext
       
    Loop
   
    DoCmd.SetWarnings True
    Text53.Visible = False
    msgbox \"Data has now been transmitted as a TOP10 Excel lists to C:\\TOP10\\\"

End Sub

fejl
User defined-type not defined

Set MyXL = New Excel.Application

Du skal huske at oprette en reference til Excel97 !!!
(stod der i mit oprindelige indlæg)

Du står i dit modul, og vælger funktioner/Referencer, og sættter kryds i Excel8.0

Til sidst får jeg et spørgsmål

A file named RESUME.XLW already exist in this location. Do you wan to replace it

yes,no,cancel

hvis jeg svarer Yes virker det PERFEKT...

kan man ikke overrule denne medd.

Efter linien med:

  Set MyXL=Nothing

skal du skrive
  Kill \"C:\\Top10\\Resume.xlw\"

Det burde klare det...

den ligger bre ikke i det  bibliotek men på D:\\

fordi det er her jeg har lagt min DB...!!!

JEg skal lige tumle med om denne oprettes på det drev hvor DB køres fra da dette kan variere fra land til land...

Du skla nok få dine point...

Hmmm....

uanset hvad der i option på min access står som startdrev eller om jeg placetrer og kører DB fra enten c eller d-drevet vil denne fil ligge sig på d-drevet. (umiddelbart ok ), MEN

hvad nu såfremt en bruger ikke har et D-drev...
Den melder jo fejl i scriptet såfremt den ikke kan finde filen...

Er det ikke sådan at RESUME.XLW placeres i det bibliotek, hvor du lige har gemt seneste TOP10 ark???

Det ved du jo hvor er (defineres i dit script), og så bruger du bare samme sti... Eller er det mig som er helt galt på den??

undskyld min sene tilbagemelding..

Nej faktisk ikke ..!!

i mit script gemmer jeg i c:\\top10, men RESUME.XLW gemmer sig altid i roden på D:\\

så troede jeg det var fordi jeg kørte min base fra D:\\ og prøvede derfor at kopiere denne til C:\\ men RESUME.XLW gemte sig stadig i D:\\.

Så prøvede jeg under indstillinger i Access at ændre mit standard bibliotek fra at være d: til at være c: men AK...!!!! lige lidt hjalp det.

selvom der ikke helt er kommet en løsning på sidstnævnte er her dine point...

Jeg har kigget lidt frem og tilbage, og det drejer sig om en Workspace-fil...

Jeg kan ikke gennemskue, hvordan man kan komme udenom den, eller hvordan man kan vide præcis hvr den ligger...

Det kan dog være at man selv kan oprette Workspace, Workbook og Sheet, og derved vide hvilket workspace man arbejder i...