mahalwords, programmierlehrgang IV: vbasic

il secondo:

von mahal, soft & develop:

Sub import_open_all_handovers()
'+--------------------------------------------------------------
'|
'|  oeffnet nacheinander alle hovs und uebergibt sie der import_this_hov
'|
'+--------------------+-----------+-----------------------------
'| designer           | date      | bemerkungen, aenderungen
'|--------------------+-----------+-----------------------------
'| mahal, himself     | 23-12-97  |
    
    Dim quellsheet, zielsheet As Worksheet
    Dim quellbook As Workbook
    
    Dim path As String
    Dim filezaehler As Integer
    
    
    
    ' defaultwerte der variablen setzen
    'path = ?\\zurf1\daten2\lcsc\handover\?
    path = ?c:\daten\handover\?

    ' zieldatei oeffnen und in objektvariable legen
    ' Workbooks.Open ?importsample.xls? ' ist immer schon offen, weil es den code enthaelt
    Set zielsheet = Workbooks(?importsample.xls?).Sheets(?hovs?)
    
    With Application.FileSearch
        .NewSearch
        .LookIn = path
        .SearchSubFolders = True
        .FileName = ?*.xls?
        .FileType = msoFileTypeExcelWorkbooks
    End With
    
    If Application.FileSearch.Execute() > 0 Then
        MsgBox ?There were ? & Application.FileSearch.FoundFiles.Count & ? file(s) found.?
              
        For filezaehler = 1 To Application.FileSearch.FoundFiles.Count
            Workbooks.Open FileName:=Application.FileSearch.FoundFiles(filezaehler), ReadOnly:=True
            ' bei der geoeffneten quelle wird davon ausgegangen, dass das sheet mit den daten das active ist.
            Set quellbook = ActiveWorkbook
            Set quellsheet = ActiveWorkbook.ActiveSheet
            
            ' aufrufen des importerz
            Call import_this_hov(quellsheet, zielsheet, quellbook.path, quellbook.Name)
            
            ' schliessen des filez
            quellbook.Close
            
        Next
    Else
        MsgBox ?There were no files to import.?
    End If
    
End Sub


Sub import_this_hov(ByVal quellsheet As Worksheet, ByVal zielsheet As Worksheet, ByVal quellpath, ByVal quellname As String)
'+--------------------------------------------------------------
'|
'|  importiert alle eintraege die im zielsheet definiert sind vom
'|  quellsheet ins zielsheet
'|
'+--------------------+-----------+-----------------------------
'| designer           | date      | bemerkungen, aenderungen
'|--------------------+-----------+-----------------------------
'| mahal, himself     | 22-12-97  |
    
    Dim aktive_eintragsrow, aktive_suchcolumn As Integer
    Dim zu_suchen, zu_suchen_a_b, switched_zu_suchen  As String
        
    Dim a_b_column_offset As Integer
    Dim quelle_ende_unten As Integer
    
    Dim zwsp_inhalt As String
    
    ' variablen mit defaultwerten laden
    ' aktive_suchcolumn ist eins weniger weil mit dem offset dann ohne korrekturaddition gesprungen werden kann
    quelle_ende_unten = 200
    aktive_eintragsrow = zielsheet.Range(?aktive_eintragsrow?).Row
    aktive_suchcolumn = 3
    
    While aktive_suchcolumn < 192
        
        ' in der zweiten zeile stehen die quellenueberschriften
        ' in der dritten ob A oder B site
        zu_suchen = zielsheet.Range(?A2?).Offset(0, aktive_suchcolumn).Value
        switched_zu_suchen = zu_suchen_a_b
        zu_suchen_a_b = zielsheet.Range(?A3?).Offset(0, aktive_suchcolumn).Value
        
        If zu_suchen_a_b = ?A? Then
            a_b_column_offset = 1
        Else
            a_b_column_offset = 2
        End If

        ' beim ersten mal oder wenn von site A nach B wexelt: actives feld zuoberst hinsetzen
        If switched_zu_suchen <> zu_suchen_a_b Then
            quellsheet.Activate
            quellsheet.Range(?B1?).Activate
        Else
            quellsheet.Activate
        End If
        
        ' quellfelder ohne eigenen zeilennamen haben in der zieldefinition einen code ?**+1?
        If zu_suchen = ?**+1? Then
            ActiveCell.Offset(1).Activate
        Else
            ' sonst immer mit offset 1 nach unten weitersuchen
            While (zu_suchen <> ActiveCell.Value) And (ActiveCell.Row < quelle_ende_unten)
                ActiveCell.Offset(1).Activate
            Wend
        End If
        
        ' inhalt der zelle auslesen
        zwsp_inhalt = ActiveCell.Offset(0, a_b_column_offset).Value
        
        ' und ins ziel schreiben
        zielsheet.Range(?A1?).Offset(aktive_eintragsrow, aktive_suchcolumn).Value = zwsp_inhalt
        
        ' suchcolumn um eins nach rechts schieben
        aktive_suchcolumn = aktive_suchcolumn + 1
        
        ' flackern lassen!! so zur show
        ' zielsheet.Activate
        ' Range(?A1?).Offset(0, aktive_suchcolumn).Activate
        
        ' und dies bis ans ende, bei der 193 column
    Wend
            
    ' im zielsheet pfad und name eingeben, das finished auf true setzen
    zielsheet.Range(?A1?).Offset(aktive_eintragsrow).Value = quellpath
    zielsheet.Range(?B1?).Offset(aktive_eintragsrow).Value = quellname
    zielsheet.Range(?C1?).Offset(aktive_eintragsrow).Value = True
    
    ' im zielsheet die aktive eintragsrow um eins nach unten setzen
    zielsheet.Range(?A? & zielsheet.Range(?aktive_eintragsrow?).Offset(1).Row).Name = ?aktive_eintragsrow?
            
End Sub



--=--=--=--=--=--=--=--=--=--=--=--=--=--=--

reicht mahalwords interessierten weiter!

questions & comments & texte, die
ihr davon findet, sie seien es wert, 
dass es die ganze welt erfaehrt, so 
 all
this stuff

du willst auch? immer mehr?
dann abonnier auch du die mahalmaillist:
 mit den worten:
?SUBSCRIBE mahalwords mein_name?
oder zum abonnement loeschen:
?UNSUBSCRIBE mahalwords mein_name?

mehr infos & befehle & archive auf dem www:
<http://www.skandal.ch/mahal/words/>