I am working on a workbook that has 2500 interview questions in it for specific managers in a company. Since it differs per region, the excel file generates (using VBA) a new file, sorted per manager with the applicable questions. Now; to calculate the score and make life easier. The newly generated file has a sheet with some buttons, one of which the calculate button. Since the sheet is copied from the main (lets call it; database file), the buttons are linked to the VBA scripts in this database. However; since the new file also includes these codes, I need the buttons to run the codes in the newly generated file.
To do so; I tried working a code in my new file generation VBA code. It worked once, and since some last tweaks, it does nothing. Comes up with a code 400 or other error. Could someone please help me?! Please find the code below.
(As I'm dutch, some references are in Dutch. Sure you will understand what is meant though! )
PHP Code:
Sub Bewaren()
'Working in Excel 2000-2010
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long
Dim fact1 As String
Dim bestandsnaam As String
Dim cptype As String
Dim space As String
bestandsnaam = Sheets("Data_sheet_1").Range("C23").Text
cptype = Sheets("Data_sheet_1").Range("C24").Text
space = "_"
'Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:="", _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
If fname <> False Then
'Copy the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'We use the 2000-2003 format xlWorkbookNormal here to save as xls
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
Else
'Give the user the choice to save in 2000-2003 format or in one of the
'new formats. Use the "Save as type" dropdown to make a choice,Default =
'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
fname = Application.GetSaveAsFilename(InitialFileName:=Format$(Date, "yyyy") & space & bestandsnaam & space & cptype, filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select
'Now we can create/Save the file with the xlFileFormat parameter
'value that match the file extension
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
'Copies the ActiveSheet to new workbook
Sheets(Array("Menu", "GM", "S&P", "ACC-TM", "HRM", "LM", "FOM", "Scores")).Select
Sheets(Array("Menu", "GM", "S&P", "ACC-TM", "HRM", "LM", "FOM", "Scores")).Copy
Set NewWb = ActiveWorkbook
'Save the file in the format you choose in the "Save as type" dropdown
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
End If
End If
Dim SourceFile As Workbook
Dim HomeBook As Workbook
Dim OtherBook As Workbook
Dim shp As Shape
Dim Answer As String
Dim MyNote As String
MyNote = "The file is generated, do you want to clear all entries?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Tool opschonen?")
If Answer = vbNo Then
cancel = True
Else
Call clear_sheet
MsgBox ("All entries are deleted, the tool is ready to use.")
End If
End Sub
Sorry if things are not clear, but please try to help me if you can!
LinkBack URL
About LinkBacks
COMPLETELY lost in VBA
)
Register To Reply
Bookmarks