If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#31
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
What is cboOffering? Should I include the name of the xlsheet under
xlSheet.Name or leave it like it is? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub *********************** Here is a formatting example With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(str(intX)) strRightRange = "S" & Trim(str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX ********************************* Here is putting in formulas. You could use the Excel Sum function for your totals With xlSheet .Cells(30, 2).Formula = "=+B29" .Cells(30, 3).Formula = "=+B30+C29" .Cells(30, 4).Formula = "=+C30+D29" .Cells(30, 5).Formula = "=+D30+E29" .Cells(30, 6).Formula = "=+E30+F29" .Cells(30, 7).Formula = "=+F30+G29" .Cells(30, 8).Formula = "=+G30+H29" .Cells(30, 9).Formula = "=+H30+I29" .Cells(30, 10).Formula = "=+I30+J29" .Cells(30, 11).Formula = "=+J30+K29" .Cells(30, 12).Formula = "=+K30+L29" .Cells(30, 13).Formula = "=+L30+M29" End With ******************* Here's how you create a new worksheet Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub *************************** Then, once you are done: xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If |
#32
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
Klatuu,
I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub *********************** Here is a formatting example With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(str(intX)) strRightRange = "S" & Trim(str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX ********************************* Here is putting in formulas. You could use the Excel Sum function for your totals With xlSheet .Cells(30, 2).Formula = "=+B29" .Cells(30, 3).Formula = "=+B30+C29" .Cells(30, 4).Formula = "=+C30+D29" .Cells(30, 5).Formula = "=+D30+E29" .Cells(30, 6).Formula = "=+E30+F29" .Cells(30, 7).Formula = "=+F30+G29" .Cells(30, 8).Formula = "=+G30+H29" .Cells(30, 9).Formula = "=+H30+I29" .Cells(30, 10).Formula = "=+I30+J29" .Cells(30, 11).Formula = "=+J30+K29" .Cells(30, 12).Formula = "=+K30+L29" .Cells(30, 13).Formula = "=+L30+M29" End With ******************* Here's how you create a new worksheet Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub *************************** Then, once you are done: xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If |
#33
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
Thought I had sent all you need for DetectExcel, but I think this may have
been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub *********************** Here is a formatting example With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(str(intX)) strRightRange = "S" & Trim(str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX ********************************* Here is putting in formulas. You could use the Excel Sum function for your totals With xlSheet .Cells(30, 2).Formula = "=+B29" .Cells(30, 3).Formula = "=+B30+C29" .Cells(30, 4).Formula = "=+C30+D29" .Cells(30, 5).Formula = "=+D30+E29" .Cells(30, 6).Formula = "=+E30+F29" .Cells(30, 7).Formula = "=+F30+G29" .Cells(30, 8).Formula = "=+G30+H29" .Cells(30, 9).Formula = "=+H30+I29" .Cells(30, 10).Formula = "=+I30+J29" .Cells(30, 11).Formula = "=+J30+K29" .Cells(30, 12).Formula = "=+K30+L29" .Cells(30, 13).Formula = "=+L30+M29" End With ******************* Here's how you create a new worksheet Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet |
#34
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
Klatuu,
I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub *********************** Here is a formatting example With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(str(intX)) strRightRange = "S" & Trim(str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX ********************************* Here is putting in formulas. You could use the Excel Sum function for your totals |
#35
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
yes, 25,6 means row 25 column 6
The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub |
#36
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
I thought I put the formula in the spreadsheet with the .cell, didn't I? If
I need to manually create a formula in the spreadsheet that defeats its purpose. I have 18 spreadsheets that will be saved every month and it would be preferrable if the user did not have to sum every one of these. Also, the fields in the form cannot be edited because it is a bound field. If I unbound it it will let me edit the amount, but it changes all rows because the form is continuous. I seem to be stuck right there... I could of course let the user edit the amounts in the saved spreadsheet and reimport it to the DB but that just seems so unncessary. I wish there was a simple way to both save the fields edited in the form and export it to excel with the total shown. "Klatuu" wrote: yes, 25,6 means row 25 column 6 The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* The above code uses this code. The code below should go it it's own module just like you did for the Common Dialog API. I call mine modExcelRoutines Option Compare Database Option Explicit ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long |
#37
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
Where do you want to save the totals? No, you don't have to manually enter
the formual, if you did create the formula to do the totals, they should be showing up in the spreadsheet. double check the sheet to see what is in the cells where you expect the formula to calculate the totals. Well, here we hit an issue. It is a basic database rule to never carry calculated values in a table. Waste's time and space, and are not totally reliable. However, sometimes we don't have total control of our world. I don't know what you are calculating, but if it is a calculation of fields witihin one record, then you could create an unbound text box on your form and do the calculation there. As I recall, you also wanted the user to be able to override the calculation. If this is the case, then you need to put the calculation code in the Current event of your form. Depending on the behaviour of your form it may need to be other places as well. But, at least you can do the calculation in the unbound text box on your form and the user can change it. It will not go directly to the spreadsheet, because it is not bound, but if your spreadsheet is doing the same calculation, it doesn't matter. "Elleve" wrote: I thought I put the formula in the spreadsheet with the .cell, didn't I? If I need to manually create a formula in the spreadsheet that defeats its purpose. I have 18 spreadsheets that will be saved every month and it would be preferrable if the user did not have to sum every one of these. Also, the fields in the form cannot be edited because it is a bound field. If I unbound it it will let me edit the amount, but it changes all rows because the form is continuous. I seem to be stuck right there... I could of course let the user edit the amounts in the saved spreadsheet and reimport it to the DB but that just seems so unncessary. I wish there was a simple way to both save the fields edited in the form and export it to excel with the total shown. "Klatuu" wrote: yes, 25,6 means row 25 column 6 The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson Okay, Here are some samples. First, here is how you open an Excel Spreadsheet for Automation: 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlBook.Worksheets("Actuals_res_export").Activate ******************* |
#38
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
I want to save the totals for use in some other forms, and I thought it might
be easiest to save to another table for that purpose. The field "calculated" is not really a calculated field, but there are certain criterias for it to show up. If criteria met then show value, else keep zero. I guess that since the user should be allowed to overwrite this field anyways, it doesn't have to have those criterias (even though it would be helpful). If I make these changes I will still need to have a field next to this record that will contain the value as default but allow the user to change so it can be saved. Can it still be saved if I do that? I checked the cells in the spreadsheet created and the cells are blank. I could run through the code and see step by step, but I'm a little bit rusty in that area. Actually, the user can only change ONE field and then that field changes the rest of the form to the same amount. That's not what I want. "Klatuu" wrote: Where do you want to save the totals? No, you don't have to manually enter the formual, if you did create the formula to do the totals, they should be showing up in the spreadsheet. double check the sheet to see what is in the cells where you expect the formula to calculate the totals. Well, here we hit an issue. It is a basic database rule to never carry calculated values in a table. Waste's time and space, and are not totally reliable. However, sometimes we don't have total control of our world. I don't know what you are calculating, but if it is a calculation of fields witihin one record, then you could create an unbound text box on your form and do the calculation there. As I recall, you also wanted the user to be able to override the calculation. If this is the case, then you need to put the calculation code in the Current event of your form. Depending on the behaviour of your form it may need to be other places as well. But, at least you can do the calculation in the unbound text box on your form and the user can change it. It will not go directly to the spreadsheet, because it is not bound, but if your spreadsheet is doing the same calculation, it doesn't matter. "Elleve" wrote: I thought I put the formula in the spreadsheet with the .cell, didn't I? If I need to manually create a formula in the spreadsheet that defeats its purpose. I have 18 spreadsheets that will be saved every month and it would be preferrable if the user did not have to sum every one of these. Also, the fields in the form cannot be edited because it is a bound field. If I unbound it it will let me edit the amount, but it changes all rows because the form is continuous. I seem to be stuck right there... I could of course let the user edit the amounts in the saved spreadsheet and reimport it to the DB but that just seems so unncessary. I wish there was a simple way to both save the fields edited in the form and export it to excel with the total shown. "Klatuu" wrote: yes, 25,6 means row 25 column 6 The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else ' Excel is running so use the SendMessage API ' function to enter it in the Running Object Table. SendMessage Hwnd, WM_USER + 18, 0, 0 End If End Sub Sub CreateNewSheet(xlApp As Object, xlBook As Object, xlSheet As Object) 'Create a new worksheet xlApp.Worksheets.Add.Move after:=xlApp.Worksheets(xlApp.Worksheets.Count) xlBook.Worksheets(xlBook.Worksheets.Count).Activat e Set xlSheet = xlBook.ActiveSheet xlSheet.Name = strChartName End Sub What should I do to make it work? "Klatuu" wrote: Which column is it you want to enter the data in? And for your next lesson |
#39
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
In this case, perhaps adding a field to your table to hold that value is
necessary. Then you could include it in your query and export it to Excel with the others. What you can do to give them the initial calculated value to start with is to use the default value property of the new text box to do the calculation. Then if they change it, it will contain whatever value they entered. "Elleve" wrote: I want to save the totals for use in some other forms, and I thought it might be easiest to save to another table for that purpose. The field "calculated" is not really a calculated field, but there are certain criterias for it to show up. If criteria met then show value, else keep zero. I guess that since the user should be allowed to overwrite this field anyways, it doesn't have to have those criterias (even though it would be helpful). If I make these changes I will still need to have a field next to this record that will contain the value as default but allow the user to change so it can be saved. Can it still be saved if I do that? I checked the cells in the spreadsheet created and the cells are blank. I could run through the code and see step by step, but I'm a little bit rusty in that area. Actually, the user can only change ONE field and then that field changes the rest of the form to the same amount. That's not what I want. "Klatuu" wrote: Where do you want to save the totals? No, you don't have to manually enter the formual, if you did create the formula to do the totals, they should be showing up in the spreadsheet. double check the sheet to see what is in the cells where you expect the formula to calculate the totals. Well, here we hit an issue. It is a basic database rule to never carry calculated values in a table. Waste's time and space, and are not totally reliable. However, sometimes we don't have total control of our world. I don't know what you are calculating, but if it is a calculation of fields witihin one record, then you could create an unbound text box on your form and do the calculation there. As I recall, you also wanted the user to be able to override the calculation. If this is the case, then you need to put the calculation code in the Current event of your form. Depending on the behaviour of your form it may need to be other places as well. But, at least you can do the calculation in the unbound text box on your form and the user can change it. It will not go directly to the spreadsheet, because it is not bound, but if your spreadsheet is doing the same calculation, it doesn't matter. "Elleve" wrote: I thought I put the formula in the spreadsheet with the .cell, didn't I? If I need to manually create a formula in the spreadsheet that defeats its purpose. I have 18 spreadsheets that will be saved every month and it would be preferrable if the user did not have to sum every one of these. Also, the fields in the form cannot be edited because it is a bound field. If I unbound it it will let me edit the amount, but it changes all rows because the form is continuous. I seem to be stuck right there... I could of course let the user edit the amounts in the saved spreadsheet and reimport it to the DB but that just seems so unncessary. I wish there was a simple way to both save the fields edited in the form and export it to excel with the total shown. "Klatuu" wrote: yes, 25,6 means row 25 column 6 The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub DetectExcel() ' Procedure dectects a running Excel and registers it. Const WM_USER = 1024 Dim Hwnd As Long ' If Excel is running this API call returns its handle. Hwnd = FindWindow("XLMAIN", 0) If Hwnd = 0 Then ' 0 means Excel not running. Exit Sub Else |
#40
|
|||
|
|||
Cannot get code to work for API Save Dialog Box
Klatuu,
That is exactly what I want to do! The table already has other fields that I will not use for any other purpose so I can use that field to store the values. I have already been searching for an answer how to save to a "new" field but was unsuccessful. How do I give these field an initial value (same as the value in the amount field)?? Should I include this into the code for the button when I link/import the tables? Not sure how to proceed with this, but I love your idea!! "Klatuu" wrote: In this case, perhaps adding a field to your table to hold that value is necessary. Then you could include it in your query and export it to Excel with the others. What you can do to give them the initial calculated value to start with is to use the default value property of the new text box to do the calculation. Then if they change it, it will contain whatever value they entered. "Elleve" wrote: I want to save the totals for use in some other forms, and I thought it might be easiest to save to another table for that purpose. The field "calculated" is not really a calculated field, but there are certain criterias for it to show up. If criteria met then show value, else keep zero. I guess that since the user should be allowed to overwrite this field anyways, it doesn't have to have those criterias (even though it would be helpful). If I make these changes I will still need to have a field next to this record that will contain the value as default but allow the user to change so it can be saved. Can it still be saved if I do that? I checked the cells in the spreadsheet created and the cells are blank. I could run through the code and see step by step, but I'm a little bit rusty in that area. Actually, the user can only change ONE field and then that field changes the rest of the form to the same amount. That's not what I want. "Klatuu" wrote: Where do you want to save the totals? No, you don't have to manually enter the formual, if you did create the formula to do the totals, they should be showing up in the spreadsheet. double check the sheet to see what is in the cells where you expect the formula to calculate the totals. Well, here we hit an issue. It is a basic database rule to never carry calculated values in a table. Waste's time and space, and are not totally reliable. However, sometimes we don't have total control of our world. I don't know what you are calculating, but if it is a calculation of fields witihin one record, then you could create an unbound text box on your form and do the calculation there. As I recall, you also wanted the user to be able to override the calculation. If this is the case, then you need to put the calculation code in the Current event of your form. Depending on the behaviour of your form it may need to be other places as well. But, at least you can do the calculation in the unbound text box on your form and the user can change it. It will not go directly to the spreadsheet, because it is not bound, but if your spreadsheet is doing the same calculation, it doesn't matter. "Elleve" wrote: I thought I put the formula in the spreadsheet with the .cell, didn't I? If I need to manually create a formula in the spreadsheet that defeats its purpose. I have 18 spreadsheets that will be saved every month and it would be preferrable if the user did not have to sum every one of these. Also, the fields in the form cannot be edited because it is a bound field. If I unbound it it will let me edit the amount, but it changes all rows because the form is continuous. I seem to be stuck right there... I could of course let the user edit the amounts in the saved spreadsheet and reimport it to the DB but that just seems so unncessary. I wish there was a simple way to both save the fields edited in the form and export it to excel with the total shown. "Klatuu" wrote: yes, 25,6 means row 25 column 6 The totals you enter are not being transferred because the query runs when you do the transferspreadsheet. Your totals are not saved with it. The solution would be to create a formula in the spreadsheet that will do the total for you. "Elleve" wrote: Klatuu, I already had the declaration of API Routines in the module with DetectExcel. When changing the cboname to my own it does not make a difference at all to the output in excel. It still outputs the same information as before and there is no sign of the totals for any of the rows I specified. Just in case this is the problem, .cell (25,6) means row 25, column 6 right? Why does it not show the total? By the way, I posted some other links under "Complicated: having user overwrite..." that relates to this issue. The fourth field called 'Approved' is basically the same as the 3rd field and should be allowed to overwrite by the user. However, neither the query nor the form is updateable. Is there a tricky way I can get around this? The amount in approved is based on the amount in the table, but because of other criterias I "calculated" a new field in the query. It seems impossible to save to a query and after reading other discussions saving should be avoided. However, this is crucial to my database. I need to save this amount to calculate the correct total. Maybe I can save a new row in the table? or create a new table with this information? "Klatuu" wrote: Thought I had sent all you need for DetectExcel, but I think this may have been left out. You can put it in the same Standard module with DetectExcel: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long As to cboOffering, it is the name of a control in my form. You will need to change all names involved to names for your controls or objects. "Elleve" wrote: Klatuu, I've been working this problem over and over and it doesn't seem to work. The program runs, but the code does not recognize DetectExcel in: If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If What needs to be done? "Klatuu" wrote: Left something out, you need this: 'Activate the sheet for totals xlBook.Worksheets(1).Activate Set xlSheet = xlBook.ActiveSheet xlSheet.Name = Me.cboOffering & " Labor Total" "Elleve" wrote: Okay, so now the code in that section looks like this: DoEvents 'xlApp.DisplayAlerts = False 'xlApp.Interactive = False 'xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) xlSheet.Name = "SupportSchedule" xlBook.Worksheets("Support Schedule").Activate However, there is no excelsheet called supportschedule created. Maybe I'm not understanding correctly what this sheet is doing. Is it taking over for the excelsheet named what the user entered? Is it hidden in the background? "Klatuu" wrote: A couple of suggestions. Add error handling to your code so if an error occurs, it will be trapped and you will know what is not working. Comment out these 3 lines: xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Then set a breakpoint on this line and step through your code. After each line executes, switch to the Excel sheet to see what happened. xlSheet.Name = "WhatEverYouWant" "Elleve" wrote: I made the corrections and called the excel sheet "Support Schedule" instead. Did I maybe put the coding in the wrong place? It seems to be not catching up on the formulas at all, and not the coloring either. Maybe it does not recognize the with statements at all? Excel only displays what was there originally before we added on the format and total code. "Klatuu" wrote: I am not sure why you are not seeing the totals; however, there are a couple of things you should look at. See notes below: "Elleve" wrote: I still cannot get the sum to display in the spreadsheet. Here is my code: Private Sub cmdExportSupportSchedule_Click() Dim strFilter As String Dim lngFlags As Long Dim strDefaultDir As String Dim varGetFileName As Variant 'Set filter to show only Excel spreadsheets strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)") 'Hides the Read Only Check Box on the Dialog box lngFlags = ahtOFN_HIDEREADONLY 'Get the File Name To Save strDefaultDir = "c:\" varGetFileName = ahtCommonFileOpenSave( _ OpenFile:=False, _ InitialDir:=strDefaultDir, _ Filter:=strFilter, _ FileName:=strDefaultFileName, _ Flags:=lngFlags, _ DialogTitle:="Save Report") Me.Repaint If varGetFileName "" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qrySupportScheduleUnionqry1and2", varGetFileName, True End If 'Open Excel On Error Resume Next ' Defer error trapping. Set xlApp = GetObject(, "Excel.Application") If Err.Number 0 Then blnExcelWasNotRunning = True Set xlApp = CreateObject("excel.application") Else DetectExcel End If Err.Clear ' Clear Err object in case error occurred. 'On Error GoTo LoadAdjustedActuals_Err DoEvents xlApp.DisplayAlerts = False xlApp.Interactive = False xlApp.ScreenUpdating = False Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True) ?? Your workbook will not have the worksheet name Actuals_res_export. I am suprised you are not getting an error. If you want a specific name for a worksheet, there are two places it can be done. One would be in the TransferSpreadsheet above, you would give it a name by using the Range argument of the TransferSpreadsheet. The other would be to name it after you have opened the workbook. It will open to the first sheet, so you can name it the xlSheet.Name = "WhatEverYouWant" xlBook.Worksheets("Actuals_res_export").Activate ' Format output With xlSheet For intX = 2 To lngItmCount + 1 strLeftRange = "C" & Trim(Str(intX)) strRightRange = "S" & Trim(Str(intX)) For Each cell In xlSheet.Range(strLeftRange, strRightRange) cell.Font.Size = 10 cell.Font.Name = "Arial" cell.Font.Bold = True ?? conLightBlue is a constant I set in my app to make the cell background light bue. Here are the constants I set up because I never can remember all the color numbers: Const conLightGray As Long = 12632256 Const conLightBlue As Long = 16777164 Const conLightYellow As Long = 10092543 cell.Interior.Color = conLightBlue cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)" Next Next intX End With 'Formulas to add each column of amount With xlSheet .Cells(25, 6).Formula = "=sum(F2:F24)" .Cells(25, 7).Formula = "=sum(G2:G24)" .Cells(25, 8).Formula = "=sum(H2:H24)" .Cells(25, 9).Formula = "=sum(I2:I24)" End With 'Done and save xlBook.Save xlBook.Close If blnExcelWasNotRunning = True Then xlApp.Quit Else xlApp.DisplayAlerts = True xlApp.Interactive = True xlApp.ScreenUpdating = True End If Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub ***************************************** As for the module I created this: ' Declare necessary API routines: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Visio Shortcuts | [email protected] | Visio | 1 | December 28th, 2006 11:28 PM |
Save work automatically | Ramon Niese | General Discussions | 2 | November 7th, 2005 04:59 PM |
Make Change Case in Excel a format rather than formula | Kevin | Worksheet Functions | 1 | March 18th, 2005 08:53 PM |
Open File and Save As don't work | David Evans | Powerpoint | 8 | June 4th, 2004 04:25 PM |
Two versions again-language issue | Otto | Setup, Installing & Configuration | 3 | May 28th, 2004 04:57 AM |