VBA Code popup en actie afhankelijk van data in werkblad

  • Onderwerp starter Onderwerp starter pvag
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
P

pvag

Gebruiker
Lid geworden
7 jan 2009
Berichten
64
Beste experts,

ik ben er weer!
Op het werkblad 'Bank_1e_kw' staat wat data en een knop 'Impoteer 1e kwartaal'.
De data op het blad in regel 1 is vast en mag dus nooit worden verwijderd.
Nu is het volgende de bedoeling:

Als op 'Impoteer CSV' wordt geklikt, moet eerst gekeken worden of het werkblad 'Bank_1e_kw' van af regel 2
data bevat. Als er in dit blad vanaf regel 2 data is gevonden, dan zal het popup scherm moeten verschijnen
(zit al in de code, en verschijnt nu dus altijd) met de melding, dat importeren niet gaat omdat het blad al data bevat.
Als in het werkblad 'Bank_1e_kw' regel 1 de standaard tekst bevat, en regel 2 met de daaropvolgende regels leeg zijn,
mag direct het scherm worden geopend om eem bestand te kiezen.

Wie weet de oplossing?
Alvast bedankt,
Ton.

Code: 
'D10  Bestandsnaam                                                                          : INGB 0007 992960 1e kwart
'D11  Voer het path in waar het excelbestand moet worden opgeslagen : E:\Werkmap\TDEP\Administratie\Bank_import


Private Sub MappenAanmaken_Click()
 
 sPad = Sheets("Param").Range("F11").Value & "\"                      ' De map wordt eerst aangemaakt volgens Param F11
    Pad = Split(sPad, "\")
    sPad = Pad(0)
    For i = 1 To UBound(Pad)
        sPad = sPad & "\" & Pad(i)
        If Dir(sPad, vbDirectory) = "" Then
        MkDir sPad
        End If
        Next i
   
End Sub

Private Sub ImprtCVS_Click()
If MsgBox("Kan niet! & vbCrLf & Dit blad bevat al data. Als je die wilt wissen klik op 'Ja' om een nieuw CSV bestand te importeren." & vbCrLf & _
 vbCrLf & _
 "" & _
 vbCrLf, vbYesNo + vbInformation, "Belangrijke informatie") = vbYes Then
     Rows("2:5000").Select
    ' Selection.ClearContents
    Rows("2:2").Select
     ActiveWorkbook.Sheets("Param").Select
     Sheets("Param").Range("F10").Select
Exit Sub
Else
End If

    Dim Kiezen As Integer
    Dim Bestand As String

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        Kiezen = .Show
        If Kiezen <> 0 Then
            Bestand = .SelectedItems(1)
        End If
    End With

    If Bestand = "" Then Exit Sub
         
    With ActiveSheet.QueryTables.Add(Connection:= _
       "TEXT;" & Bestand, Destination:=Range("$A$2"))
       .Name = "INGB_1e_kwart_1"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 850
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = False
       .TextFileCommaDelimiter = True
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
    End With
End Sub
 

Bijlagen

Code: 
Private Sub ImprtCSV_Click()

'D5    Geef het path op voor opslag van de werkmap kasboek              : C:\Werkmap\TDEP\Administratie\Kasboeken
'F6    Geef het path op voor opslag van het sjabloon kasboek               : C:\Werkmap\TDEP\Sjabloon kasboek
'F7    Geef de naam op voor dit programma                                        : Kasboek
'F8    Je voornaam                                                                            : Ton
'F9    Je achternaam                                                                          : Coolen
'F10  Bestandsnaam                                                                          : INGB 0123 456789 1e kwart
'F11  Voer het path in waar het excelbestand moet worden opgeslagen : E:\Werkmap\TDEP\Administratie\Bank_import

    sPad = Sheets("Param").Range("F11").Value & "\"                      ' De map wordt aangemaakt:  E:\Werkmap\TDEP_new\Administratie\Kasboeken
    Pad = Split(sPad, "\")
    sPad = Pad(0)
    For I = 1 To UBound(Pad)
        sPad = sPad & "\" & Pad(I)
        If Dir(sPad, vbDirectory) = "" Then
        MkDir sPad
        End If
    Next I
   
    If WorksheetFunction.CountA(Sheets("Bank_1e_kwart").Columns(1)) = 1 Then
        GoTo further
    Else
        If MsgBox("FOUT! " & vbCrLf & vbCrLf & "Dit blad bevat al data die eerst moet worden gewist!" & vbCrLf & vbCrLf & _
                "Wil je de huidige data wissen en een nieuw CSV bestand te importeren." & vbCrLf & vbCrLf, _
                vbYesNo + vbInformation, "Importeren CSV") = vbYes Then
            Rows("2:5000").ClearContents
            Rows("2:2").Select
            Dim Kiezen As Integer, Bestand As String
further:
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            Kiezen = .Show
            If Kiezen <> 0 Then
                Bestand = .SelectedItems(1)
            End If
        End With

        If Bestand = "" Then Exit Sub
         
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & Bestand, Destination:=Range("$A$2"))
            .Name = "INGB_1e_kwart_1"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Exit Sub
        Else
        End If
    End If
    Application.Goto Sheets("Param").Range("F10")

End Sub
 
Beste Rudi,

Bedankt voor je hulp. Dit draait nu goed. Nu kan ik het volgende deel gaan aanpakken. Als ik er niet uit kom vraag ik de experts.
Nogmaals dank.

Mvg,

Ton
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan