Macro kürzen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Macro kürzen von: Rene
Geschrieben am: 10.03.2005 11:39:23

Moin zusammen,

Habe dieses Macro geschrieben:

Private Sub CommandButton1_Click()
If OptionButton8 = True Then
      If CheckBox1 = False Then
         
         If OptionButton1 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_mit_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_mit_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_mit_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_mit_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_mit_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_mit_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM mit Display\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_mit_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_mit_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_mit_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM mit Display\bis 0,5 mm\RCA.mem"
         End If
      End If
      
      If CheckBox1 = True Then
         
         If OptionButton1 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S49_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S49_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S49_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S49\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S54_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S54_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_S54_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\S54\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_E2_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_E2_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_mit_Display_E2_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM mit Display\E2\bis 0,5 mm\RCA.mem"
            
         End If
      End If
      
      
      If CheckBox2 = True Then
         
         If OptionButton1 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S49_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S49_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S49_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S49\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S54_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S54_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_S54_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\S54\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_E2_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_E2_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton1 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_mit_Display_E2_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM mit Display\E2\bis 0,5 mm\RCA.mem"
         End If
      End If
      
      
      If CheckBox1 = False Then
         
         If OptionButton2 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_ohne_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_ohne_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S49_ohne_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S49\DQM ohne Display\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_ohne_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_ohne_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_S54_ohne_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\S54\DQM ohne Display\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_ohne_Display_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_ohne_Display_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_E2_ohne_Display_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\E2\DQM ohne Display\bis 0,5 mm\RCA.mem"
         End If
      End If
      
      If CheckBox1 = True Then
         
         If OptionButton2 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S49_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S49_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S49_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S49\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S54_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S54_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_S54_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\S54\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_E2_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_E2_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_abge_Bogen_ohne_Display_E2_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\abgefahrener Bogen\DQM ohne Display\E2\bis 0,5 mm\RCA.mem"
            
         End If
      End If
      
      
      
      If CheckBox2 = True Then
         
         If OptionButton2 And OptionButton23 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S49_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S49_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton23 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S49_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S49\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S54_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S54_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton24 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_S54_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\S54\bis 0,5 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton20 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,2 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_E2_02 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,2 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton21 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,3 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_E2_03 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,3 mm\RCA.mem"
         ElseIf OptionButton2 And OptionButton25 And OptionButton22 = True Then
            Quelle = ("C:\DQM\RCA.mem") 'RCA suchen
            Kopie = ("C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,5 mm\RCA.mem")
            FileCopy Quelle, Kopie
            RG_48_Spur_ohne_Display_E2_05 'legt Ordner laut Modul1 an
            kill "C:\DQM\Messung\RCA\RG 48\Spur\DQM ohne Display\E2\bis 0,5 mm\RCA.mem"
         End If
      End If
   End If
End Sub


Dieses einzelne geht auch soweit wie es soll. Da das ganze aber zu groß wird weil ich das gleiche 8 mal brauch nur mit anderen Namen und ich dann den Fehler "Prozedur zu groß" bekomme wollte ich mal Fragen ob man das Macro auch kürzer schreiben kann oder wie ich das anders machen müßte

Bitte helft mir ich weiß leider nicht weiter.

Gruß Rene
Bild


Betrifft: AW: Macro kürzen von: u_
Geschrieben am: 10.03.2005 12:01:53

Hallo,
wer soll denn da durchblicken?
Anscheinend wiederholen sich die Dateinamen ständig.
Lagere sie in Variable aus und sprich diese an. Spart einen Haufe Tipparbeit und Speicherplatz.
Quelle brauchst du nicht ständig zu definieren. Am Anfang des Makros reicht.
Gruß


Bild


Betrifft: AW: Macro kürzen von: Volker
Geschrieben am: 10.03.2005 12:02:01

Hallo Rene,

erstmal Respekt, so eine Makro ohne VBA Kenntnisse ;-)

Spass beiseite, verteil deinen Code doch auf mehrere Prozeduren, in die du dann abhängig von den checkboxen und optionbuttons verzweigst.

If CheckBox1 = True Then 'if checkbox1 then sollte auch gehen
makro1
endif

If CheckBox2 = True Then
makro2
endif

usw.

Du kannst auch Bei den ganzen if's was zusammenfassen:
if OptionButton1 and OptionButton2 and OptionButton3 then
...
if OptionButton1 and OptionButton2 and OptionButton4 then
...

wird zu
if OptionButton1 and OptionButton2 then
if OptionButton3 then
.....
elseif OptionButton4 then
.....
end if

Bringt nicht sehr viel, spart aber Tipperei

Einige Befehle sind überflüssigerweise mehrfach vorhanden
Quelle = ("C:\DQM\RCA.mem") 'RCA suchen kommt zig mal vor, braucht aber nur einmal am Anfang zu stehen.

Gruß
Volker


Bild


Betrifft: AW: Macro kürzen von: Rene
Geschrieben am: 10.03.2005 12:08:54

Moin,

Danke euch beiden erstmal werde mal versuchen ob ich das hinbekomme.

Gruß Rene


Bild


Betrifft: AW: Macro kürzen von: Rene
Geschrieben am: 10.03.2005 13:17:34

Moin,Volker

Habe den Befehl Quelle.... nur einmal geschrieben und das hat schon sehr viel gebracht reicht aber leider immer noch nicht. Leider verstehe ich das mit den zusammenfassen nicht ganz kannst du mir dabei noch mal helfen?

Gruß Rene


Bild


Betrifft: AW: Macro kürzen von: u_
Geschrieben am: 10.03.2005 13:53:17

Hallo,
so wirds nochmal kürzer
Private Sub CommandButton1_Click()
Dim Quelle As String, Kopie As String, Pfad As String
Quelle = ("C:\DQM\RCA.mem") 'RCA suchen

If OptionButton8 = True Then
If CheckBox1 = False Then
Pfad = "C:\DQM\Messung\RCA\RG 48\S49\DQM mit Display\"
If OptionButton1 And OptionButton23 And OptionButton20 = True Then
Kopie = Pfad & "bis 0,2 mm\RCA.mem"
FileCopy Quelle, Kopie
RG_48_S49_mit_Display_02 'legt Ordner laut Modul1 an
Kill Kopie

ElseIf OptionButton1 And OptionButton23 And OptionButton21 = True Then
Kopie = Pfad & "bis 0,3 mm\RCA.mem"
FileCopy Quelle, Kopie
RG_48_S49_mit_Display_03 'legt Ordner laut Modul1 an
Kill Kopie

ElseIf OptionButton1 And OptionButton23 And OptionButton22 = True Then
Kopie = Pfad & "bis 0,5 mm\RCA.mem"
FileCopy Quelle, Kopie
RG_48_S49_mit_Display_05 'legt Ordner laut Modul1 an
Kill Kopie

ElseIf OptionButton1 And OptionButton24 And OptionButton20 = True Then
Kopie = Pfad & "bis 0,2 mm\RCA.mem"
FileCopy Quelle, Kopie
RG_48_S54_mit_Display_02 'legt Ordner laut Modul1 an
Kill Kopie

Da kann man aber mit Sicherheit noch mehr machen.
Gruß


Bild


Betrifft: AW: Macro kürzen von: Rene
Geschrieben am: 10.03.2005 14:27:46

Moin u,

Danke dir für deine Hilfe habe es für den einen getestet und das geht ja prima(mußte nur noch 3x End if hinzufügen) werde nun mal die anderen mit dazu nehmen und genauso schreiben hoffe das es so geht.

Wenn ich das so sehe sind meine ganzen Sachen bestimmt alle zu lang na mal sehen was sich da machen läßt.

Danke noch mal

Gruß Rene


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Eigene VBA-Funktion in Tabellenblatt verwenden"