Closed Thread
Results 1 to 2 of 2

Excel 2007 : COMPLETELY lost in VBA

  1. #1
    Registered User
    Join Date
    01-17-2012
    Location
    Tilburg
    MS-Off Ver
    Excel 2010
    Posts
    5

    Question COMPLETELY lost in VBA

    Hi all,

    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 = "_"
          
        Application.ScreenUpdating = False
                   
                Blad3.Activate
                Blad3.Cells.Select
                Selection.Clear
                Blad3.Columns("A:ZZ").Hidden = False
                Blad3.Rows("1:34000").Hidden = False
                Blad3.Columns("A:ZZ").ColumnWidth = 10
               
                Blad3.Name = "Menu"
               
                Blad55.Range("a1:k26").Copy
                Blad3.Activate
                Blad3.Range("a1").PasteSpecial xlPasteAll
                Blad3.Columns("L:XFD").Hidden = True
                Blad3.Rows("27:1048576").Hidden = True
       
                Sheets("Output_Menu").Activate
                ActiveSheet.Shapes.SelectAll
                Selection.ShapeRange.Group.Name = "Group10"
                Sheets("Output_Menu").Shapes("Group10").Copy
                Application.Goto Sheets("Menu").Range("D7")
                ActiveSheet.Paste
           
                Blad55.Activate
                ActiveSheet.Shapes.Range(Array("Group10")).Select
                Selection.ShapeRange.Ungroup.Select
               
                Blad3.Activate
                ActiveSheet.Shapes.Range(Array("Group10")).Select
                Selection.ShapeRange.Ungroup.Select
                Selection.ShapeRange.IncrementLeft 18#
                           
                Blad1.Activate
     
        '
    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 fnameFileFormat:=-4143CreateBackup:=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(fnameLen(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 fnameFileFormat:= _
                                 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
                                                  
                    SourceFile 
    ThisWorkbook.Name
                   
                        HomeBook 
    ActiveWorkbook.Name
                        Workbooks
    .Open Filename:=SourceFile
                        OtherBook 
    SourceFile
                       
                            Windows
    (OtherBook).Activate
     
                                
    For Each shp In Sheets("Menu").Shapes
                                    
    If shp.Name "printqrraudit" Then
                                        Sheets
    ("Menu").Shapes("printqrraudit").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.qrraudit_printen"
                                    
    ElseIf shp.Name "GM" Then
                                        Sheets
    ("Menu").Shapes("GM").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_GM"
                                    
    ElseIf shp.Name "SP" Then
                                        Sheets
    ("Menu").Shapes("SP").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_SP"
                                    
    ElseIf shp.Name "ACC" Then
                                        Sheets
    ("Menu").Shapes("ACC").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_ACC"
                                    
    ElseIf shp.Name "HRM" Then
                                        Sheets
    ("Menu").Shapes("HRM").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_HRM"
                                    
    ElseIf shp.Name "LM" Then
                                        Sheets
    ("Menu").Shapes("LM").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_LM"
                                    
    ElseIf shp.Name "FOM" Then
                                        Sheets
    ("Menu").Shapes("FOM").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.reg_FOM"
                                    
    ElseIf shp.Name "calc" Then
                                        Sheets
    ("Menu").Shapes("calc").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.Standard_Score"
                                    
    ElseIf shp.Name "save" Then
                                        Sheets
    ("Menu").Shapes("save").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.Bewaren"
                                    
    ElseIf shp.Name "prt" Then
                                        Sheets
    ("Menu").Shapes("prt").Select
                                        Selection
    .OnAction fact2 ".xlsm!Blad3.results_printen"
                                    
    End If
                                
    Next shp
                                   
                            Application
    .DisplayAlerts False
                            ActiveWorkbook
    .Save
                            Workbooks
    (OtherBook).Close SaveChanges:=False
                            Application
    .DisplayAlerts True
                       
                     Windows
    (HomeBook).Activate
                                             
                Sheets
    ("Main_Screen").Select
                       
                    Application
    .ScreenUpdating True
                    
        Dim Answer 
    As String
        Dim MyNote 
    As String
                 MyNote 
    "The file is generated, do you want to clear all entries?"
                 
    Answer MsgBox(MyNotevbQuestion 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!

    Thanks a lot.

  2. #2
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,166

    Re: COMPLETELY lost in VBA

    DXP,

    Welcome to the Forum, unfortunately:

    This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

    Thread Closed.
    If I have helped, Don't forget to add to my reputation (click on the star below the post)
    Don't forget to mark threads as "Solved" (Thread Tools->Mark thread as Solved)
    Use code tags when posting your VBA code: [code] Your code here [/code]

Closed Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1