MsgBox probleem en if then gaat niet goed

[MuM111]

if then gaat niet goed

Heb probleem met volgende if then code,
de if then begint bij if ActiveWorkbook.Sheets(2) Enz.

Uitleg over waar naar gekeken moet worden:
Ik heb 3 versies van basisbestanden waar de gegevens uit opgehaald dienen te worden.
Nu heb ik hier 3 knoppen voor en dat werkt zolang je maar weet welke versie het bestand heeft.
Daarom wil ik dit samenvoegen.
Alles gaat goed t/m openen workbook dan stopt alles.

Iemand die me kan helpen hiermee, BVD.

If ActiveCell = "" Then MsgBox "Geen opdrachtnummer in veld!", vbCritical, "Fout"
       
    Columns("C:AM").Hidden = False
    Range("b8:am8").Copy
    ActiveCell.Offset(, 1).PasteSpecial
    Application.CutCopyMode = False
    ActiveCell.Offset(, -1).Select
    wbnaam = "I:\ " & Format(Date, "yyyy") & "\" & ActiveCell.Value & ".xls"
    
    On Error GoTo Errorcontrole
    Workbooks.Open Filename:=wbnaam, ReadOnly:=True
        
    [COLOR="#FF0000"]If ActiveWorkbook.Sheets(2)[/COLOR] = "KALK-Zubehör" Then
    Komm = ActiveWorkbook.Sheets("KALK").Range("C5").Value
    Zusc1 = ActiveWorkbook.Sheets("KALK").Range("CV63").Value
    Zusc2 = ActiveWorkbook.Sheets("KALK-Zubehör").Range("BX61").Value
    
    ElseIf ActiveWorkbook.Sheets("KALK").Range("CV8") = "Zuschnitt" Then
    Komm = ActiveWorkbook.Sheets("KALK").Range("C5").Value
    Zusc1 = ActiveWorkbook.Sheets("KALK").Range("CV63").Value
    Zusc2 = ActiveWorkbook.Sheets("KALK Zubehör").Range("BX61").Value
    
    Else
    Komm = ActiveWorkbook.Sheets("KALK").Range("C5").Value
    Zusc1 = ActiveWorkbook.Sheets("KALK").Range("CR63").Value
    Zusc2 = ActiveWorkbook.Sheets("KALK Zubehör").Range("BX61").Value
    
    End If
        
    ActiveWorkbook.Close SaveChanges:=False
    
    Workbooks(Format(Date, "yyyy") & " macro.xls").Worksheets("Auftragen").Activate
    ActiveCell.Offset(, 2).Value = Komm
    ActiveCell.Offset(, 11).Value = (Zusc1 + Zusc2) / 2
    
Errorcontrole:
If Err.Number = 9 Then
    MsgBox "Datei is noch geöfnet", vbCritical, "Datei Bitte Schießen"
    Workbooks.Open Filename:=wbnaam, ReadOnly:=True
End If

(Probleem Msgbox is opgelost door OctaFish: bij de MsgBox gaat hij gewoon verder met de code na op de OK knop te hebben gedrukt van de melding, ik wil graag dat hij dan de code afsluit)

 

[OctaFish]

Zolang je geen Exit Sub inbouwt, zal hij gewoon doorlopen naar de volgende regel. 'Da's logisch' zou onze Landfilosoof JC zeggen

If ActiveCell = "" Then 
     MsgBox "Geen opdrachtnummer in veld!", vbCritical, "Fout"
     Exit Sub
End If

 

[MuM111]

Dank je OctaFish, dit ging snel en werkt.
Weer wat geleerd, was 1e keer met MsgBox.

 

[MuM111]

Niemand die me kan helpen, dan zal ik dus 3 opdrachtknoppen moeten blijven gebruiken

 

[mcs51mc]

Wat is het probleem eigenlijk met je 3 bestanden?
Moet je iets anders doen in funcie van het gekozen bestand?
Is er iets unieks in elk bestand die duidelijk kan maken over welk type bestand het gaat?
Indien ja, dan kan je met één knop eender welk bestand openen, dat uniek iets gaan controleren en hieruit bepalen welke actie moeten uitgevoerd worden.

Maar een vb bestandje zou véél verduidelijken

 

[MuM111]

Beste mcs51mc,

voorbeeld bestand is beetje lastig omdat het meerdere bestanden zijn.

Uitleg als volgt:
Ik heb hoofdbestand waar ik gegevens uit de opdrachtbestanden haal.
Nu zijn deze opdrachtbestanden in de Loop der tijd, en nog steeds, onderhevig aan veranderingen (kolommen erbij, cellen erbij Enz).
Er wordt steeds laatste basisbestand gebruikt om hierin de nieuwe offerte te verwerken en daarna eventueel naar opdracht.
Dus deze Basis opdrachtbestanden hebben verschillende versie nrs en dus moet er data opgehaald worden uit verschillende cellen.

In code begint 1e If als sheet 2 "KALK-Zubehör" is
2e is kijken of een cel de inhoud "Zuschnitt" heeft
als beide dus niet van toepassing zijn zal hij de laatste else uitvoeren.

Code blijft al hangen bij 1e If, ik weet niet hoe ik anders de naam van sheet 2 moet testen?

Ik hoop dat je mee verder kunt helpen, als je echt testbestan(en) nodig hebt geef het dan aan dan maak ik kopieën en strip deze voor je.

Bvd

 

[mcs51mc]

Wanneer je volgens de sheetnaam een selectie moet maken tussen versies dan zou ik een "For Each" gebruiken om door alle sheets van het active workbook te gaan en een "Select case" om afhankelijk van de naam van de sheet iets te doen.
Ik zet alle sheet namen om naar hoofdletters met de UCase funtie om zeker geen probleem te hebben met hoofd- en kleine letters.

Dim objWorkbook         As Workbook
Dim objMySheet          As Worksheet

        For Each objMySheet In objWorkbook.Worksheets
        
            Select Case UCase(objMySheet.Name)
                Case UCase("KALK-Zubehör"))
                    'Hier komt de code wanneer het om een "KALK-Zubehör" sheet gaat
                    
                    
                Case UCase("KALK"))
                    'Hier komt de code wanneer het om een "KALK" sheet gaat                    
                    

                Case Else
                    'Niets doen daar onbekende sheet 
                    
            End Select
        Next

Indien dit nog geen oplossing is voor je probleem best toch eens een aantal filekes samen steken in een zip en deze posten.
Hopelijk kan je zip's posten

 

[MuM111]

Beste mcs51mc,

bedankt voor de tijd die u ervoor genomen heeft.
Gezien vakantietijd van collega's moet ik dit even op lager pitje zetten, opdrachten verwerken gaat voor.
Ik heb er even vluchtig naar gekeken maar alleen 1e sheet moet op sheet gecontroleerd worden, 2e selectie is celcontrole in KALK sheet.

Ik zal, als het wat rustiger is, tijd ervoor nemen om wat voorbeeld Sheets te maken en als zip te posten.
Hoop dat U dan wat tijd heeft om ernaar te kijken.

Mvg