Import txt in excel macro - instelling na klik op annuleren

Status
Niet open voor verdere reacties.
J

Jussie

Gebruiker
Lid geworden
21 jul 2012
Berichten
24
Goedenavond !

Ik heb een vraag, de volgende macro heb ik via zoeken weten te bemachtigen, het betreft een macro waarmee ik een text bestand in Excel importeer en naar wensen direct goed gezet wordt.
Nu wil ik graag nog erbij hebben, dat als men op annuleren drukt ( in het pop up menu waarmee je het gewenste txt bestand kan selecteren ) automatisch het tabblad "IMPORTEREN" weer netjes verborgen wordt.
En als men gewoon een text bestand selecteert en dubbel klikt, de macro gewoon zijn werk doet, ik waardeer jullie werk op dit forum en hoop dat iemand mij hiermee kan helpen. Waarschijnlijk is het niet zo moeilijk, maar ik kom net kijken bij het programmeren. ('t is verslavend merk ik...)

hierbij de macro, en alvast bedankt !
--------------------

Sub Import_bestand()
'
' Import_bestand Macro
'

'
Sheets("INVOERSCHEMA").Select
Sheets("IMPORTEREN").Visible = True
Sheets("IMPORTEREN").Select
Dim varBron As Variant
ChDrive "C"
ChDir "C:\documents and settings\compaq_administrator\mijn documenten\financiën\import 2012"
varBron = Application.GetOpenFilename
'als niet op annuleren is geklikt dan gegevens ophalen
If varBron <> False Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varBron, _
Destination:=Range("A1"))
.Name = "Nr 38"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

Columns("D:D").Select
Selection.Replace What:="C", Replacement:="BIJ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="D", Replacement:="AF", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("E:E").Select
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Range("A1").Select
Selection.End(xlDown).Select
Selection.ClearContents

Range("A1:N600").Select
Selection.Copy
Sheets("INVOERSCHEMA").Select
Range("D2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M2").Select
Selection.Copy
Range("M3:M23503").Select
ActiveSheet.Paste
Range("D2").Select
Selection.End(xlDown).Select
Sheets("IMPORTEREN").Select
Application.CutCopyMode = False
Cells.Select
Selection.QueryTable.Delete
Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("IMPORTEREN").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("INVOERSCHEMA").Select
Range("D2").Select
Selection.End(xlDown).Select
End With
End If
End Sub
------------------------------------------

gr. Jussie
 
Maak dan het werkblad pas zichtbaar als je daadwerkelijk een textbestand geselecteerd hebt, dus na If varBron <> False then...
Klik je echter op annuleren dan blijft het werkblad sowieso verborgen.
De les is dus dat je geen dingen al op voorhand gaat doen alvorens de gewenste actie ondernomen is.;)
Er is nog wel wat werk aan je macro ivm het vermijden van Select, Selection ed (dit werkt vertragend, is verwarrend en in 99% v/d gevallen overbodig) maar dit is hier even van ondergeschikt belang.
Zet volgende keer je macro ook tussen codetags, dat leest makkelijker.
Selecteer hiervoor je macro tekst en klik dan op het #-teken.
 
Laatst bewerkt:
Zie rode tekst

Code: 
Sub Import_bestand()
'
' Import_bestand Macro
'

'
Sheets("INVOERSCHEMA").Select
Sheets("IMPORTEREN").Visible = True
Sheets("IMPORTEREN").Select
Dim varBron As Variant
ChDrive "C"
ChDir "C:\documents and settings\compaq_administrator\mijn documenten\financiën\import 2012"
varBron = Application.GetOpenFilename
'als niet op annuleren is geklikt dan gegevens ophalen
If varBron <> False Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varBron, _
Destination:=Range("A1"))
.Name = "Nr 38"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

Columns("D").Select
Selection.Replace What:="C", Replacement:="BIJ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="D", Replacement:="AF", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("E:E").Select
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Range("A1").Select
Selection.End(xlDown).Select
Selection.ClearContents

Range("A1:N600").Select
Selection.Copy
Sheets("INVOERSCHEMA").Select
Range("D2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M2").Select
Selection.Copy
Range("M3:M23503").Select
ActiveSheet.Paste
Range("D2").Select
Selection.End(xlDown).Select
Sheets("IMPORTEREN").Select
Application.CutCopyMode = False
Cells.Select
Selection.QueryTable.Delete
Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("IMPORTEREN").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("INVOERSCHEMA").Select
Range("D2").Select
Selection.End(xlDown).Select
End With
[COLOR="#FF0000"]Else
Sheets("IMPORTEREN").Visible = False[/COLOR]
End If
End Sub

Warmbakkertje was me voor...
De optie van warmbakkertje is altijd beter.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan