VBA Definering af fil udfra valg af Opdater/Nyt via userform
HejJeg har denne kode, der er indarbejdet i en fil med en makro, som startes fra SAP. Indtil nu er den kun benyttet til at opdatere en NY excelfil. Jeg vil gerne have at brugeren kan vælge en ny fil eller vælge at opdatere en eksisterende.
Dertil har jeg forsøgt med et simpel valg via en userform.
Men da makroens hovedformål er, at hente data fra 3 forskellige filer ind i arket - kunne jeg godt tænke mig at genbruge denne kode afhængig af valg.
Men jeg er ikke stærk i dette med definering af filer, herunder valg. Kan en eller anden hjælpe? Se nedenfor:
Private Sub CommandButton1_Click()
If OptionButtonNyt = True Then OpretNyt '
If OptionButtonOpdater = True Then Opdater
Userform1.Hide
End Sub
Sub Makro1()
' VALG 1: OPRET NYT
' Åbner skabelon
Application.DisplayAlerts = False
Workbooks.Open Filename:="F:\NyFil.xls"
Application.ScreenUpdating = False
Application.WindowState = xlMaximized
‘ VALG 2: OPDATER GAMMEL FIL
ChDrive ("f")
ChDir "F:\"
Application.Dialogs(xlDialogOpen).Show
' Går til medarbejderens c-drev for at finde fil nr. 1
ChDir "C:\TEMP"
Workbooks.OpenText Filename:="C:\TEMP\RAABAL", Origin:=xlWindows, StartRow _
:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(4, 1), Array( _
10, 1), Array(34, 1), Array(50, 1), Array(66, 1), Array(82, 1), Array(98, 1), Array(114, 1), _
Array(130, 1)), TrailingMinusNumbers:=True
Range("A1:I1082").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Copy
Windows("NyFil.xls").Activate
Application.GoTo Reference:="Råbalance"
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=10
ActiveWindow.SmallScroll Down:=29
Windows("RAABAL").Activate
ActiveWindow.Close
' Går til medarbejderens c-drev for at finde fil nr. 2
Workbooks.OpenText Filename:="C:\TEMP\RAABAL2", Origin:=xlWindows, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(4, _
1), Array(10, 1), Array(34, 1), Array(50, 1), Array(66, 1), Array(82, 1), Array(98, 1), _
Array(114, 1), Array(130, 1), Array(146, 1), Array(162, 1), Array(178, 1), Array(194, 1), _
Array(210, 1)), TrailingMinusNumbers:=True
Range("A1:N170").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Copy
Windows("NyFil.xls").Activate
Application.GoTo Reference:="RåVedligeholdelsesplan"
ActiveSheet.Paste
Range("B2").Select
Windows("RAABAL2").Activate
ActiveWindow.Close
‘ Finder fil nr. 3 på fællesdrev
Dim filnavn As String
Dim s1, s2 As String
filnavn = "F:\Stamoplysninger\"
Application.GoTo Reference:="Råbalance1"
ActiveCell.Select
s1 = ActiveCell.Value
s2 = Mid(s1, 1, 3) & "-"
s2 = s2 & Mid(s1, 4, 1) & ".txt"
filnavn = filnavn & "A" & s2
ChDir "F:\Stamoplysninger"
Workbooks.OpenText Filename:=filnavn, _
Origin:=xlWindows, StartRow:=2, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), _
Array(2, 1))
Range("A1:A124").Select
Selection.Copy
Windows(2).Activate
Application.GoTo Reference:="ForsideOplysninger"
ActiveCell.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Windows(2).Activate
ActiveWorkbook.Close
ChDir "F:\"
ActiveWorkbook.SaveAs Filename:="F:\Afdelingsregnskab.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.Dialogs(xlDialogSaveAs).Show
Application.ScreenUpdating = True
Range("A1").Select
Windows("Makro").Activate
ActiveWorkbook.Close
End sub
