10. april 2007 - 06:58Der er
18 kommentarer og 1 løsning
hjælp til kode der låser datafil
Det er når jeg står på de enkelte filer og henter data vi koden
Det går ganske fint, men bagefter kan jeg ikke få lov ta komme ind i min datafil(version1). Der står at den er skrivebeskyttet og i brug af mig selv om den ikke er. Jeg kan så lukke hele maskinen ned og så kan jeg komme ind i filen igen. Men så snrt jeg bruger nedenstående makro går det galt igen.
Const dataSti = "\\sti\" Const dataFilNavn = "version1.xls" Dim kNrRæk, knr Sub knap() Rem kundenr fra aktuellefil-navn knr = Left(ActiveWorkbook.Name, 4)
hentFraDatafil Val(knr) End Sub Private Sub hentFraDatafil(knr) Dim xls Set xls = CreateObject("Excel.application") With xls .Workbooks.Open Filename:=dataSti + dataFilNavn kNrRæk = .ActiveCell.SpecialCells(xlLastCell).Row
For ræk = 3 To kNrRæk If knr = .Cells(ræk, 2) Then ActiveWorkbook.Sheets(1).Cells(3, 3) = .Cells(ræk, 2) ActiveWorkbook.Sheets(1).Cells(11, 3) = .Cells(ræk, 3) Set xls = Nothing Exit Sub End If Next ræk End With Set xls = Nothing MsgBox ("Kundenr. " + knr + " ikke fundet") End Sub
Rem Version 10-04-07 Rem ================ Const dataSti = "C:\Documents and Settings\pb\Skrivebord\Spoi\" 'tilpasses Const dataFilNavn = "dataFil.xls" 'tilpasses" Dim kNrRæk, knr, xls Sub knap() Rem kundenr fra aktuellefil-navn knr = Left(ActiveWorkbook.Name, 4)
hentFraDatafil Val(knr) End Sub Private Sub hentFraDatafil(knr) Set xls = CreateObject("Excel.application") With xls .Workbooks.Open Filename:=dataSti + dataFilNavn kNrRæk = .ActiveCell.SpecialCells(xlLastCell).Row
For ræk = 3 To kNrRæk If knr = .Cells(ræk, 2) Then ActiveWorkbook.Sheets(1).Cells(5, 4) = .Cells(ræk, 3) ActiveWorkbook.Sheets(1).Cells(3, 11) = .Cells(ræk, 4) LukXLS Exit Sub End If Next ræk End With LukXLS MsgBox ("Kundenr. " + knr + " ikke fundet") End Sub Private Sub LukXLS() xls.ActiveWorkbook.Close xls.Application.Quit Set xls = Nothing End Sub
Const dataSti = "\\sti\Versionsstyring\" Const dataFilNavn = "version.xls" Dim kNrRæk, knr Sub knap() Rem kundenr fra aktuellefil-navn knr = Left(ActiveWorkbook.Name, 4)
hentFraDatafil Val(knr) End Sub Private Sub hentFraDatafil(knr) Dim xls Set xls = CreateObject("Excel.application") With xls .Workbooks.Open Filename:=dataSti + dataFilNavn kNrRæk = .ActiveCell.SpecialCells(xlLastCell).Row
For ræk = 3 To kNrRæk If knr = .Cells(ræk, 2) Then ActiveWorkbook.Sheets(1).Cells(3, 3) = .Cells(ræk, 2) ActiveWorkbook.Sheets(1).Cells(11, 3) = .Cells(ræk, 3) LukXLS 'Set xls = Nothing Exit Sub End If Next ræk End With LukXLS 'Set xls = Nothing MsgBox ("Kundenr. " + knr + " ikke fundet") End Sub Private Sub LukXLS() xls.ActiveWorkbook.Close xls.Application.Quit Set xls = Nothing
Flyt koden, som du har i LukXLS ind i hentFraDatafil, hvor du har dit objekt xls. Da din variabel er erklæret indenfor proceduren, kan du ikke tilgå det i en anden procedure (så skal du i hvertfald sende objektet med ned i den anden procedure).
Ind i mellem hænger den kun et par minutter - og jeg skal feks helt ud af stifinder. Andre gange skriver den at filen er åben og så åbner den bare. Stabilt er det i hvert fald ikke.
Kan denne her kode evt bruges og omskrives. den henter data fint. Men det skal automatiseres at den henter fra den korrekte række. Dvs den række der har det rette kundenr som også fremgår af den fil jeg kører makroen fra.
Sub TestGetValue() p = "\\sti\Versionsstyring" f = "version.xls" s = "Ark1" a = "A1" Application.ScreenUpdating = False
a = Cells(5, 2).Address Cells(3, 3) = GetValue(p, f, s, a) a = Cells(5, 3).Address Cells(11, 3) = GetValue(p, f, s, a) a = Cells(5, 4).Address Cells(15, 3) = GetValue(p, f, s, a)
Application.ScreenUpdating = True End Sub
Private Function GetValue(path, file, sheet, ref) ' Retrieves a value from a closed workbook Dim arg As String
' Make sure the file exists If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "Filen findes ikke" Exit Function End If
Const dataSti = "\\sti\Versionsstyring\" Const dataFilNavn = "version.xls" Dim kNrRæk, knr, xls Sub knap() Rem kundenr fra aktuellefil-navn knr = Left(ActiveWorkbook.Name, 4)
hentFraDatafil Val(knr) End Sub Private Sub hentFraDatafil(knr) Set xls = CreateObject("Excel.application") With xls .Workbooks.Open Filename:=dataSti + dataFilNavn kNrRæk = .ActiveCell.SpecialCells(xlLastCell).Row
For ræk = 3 To kNrRæk If knr = .Cells(ræk, 2) Then ActiveWorkbook.Sheets(1).Cells(3, 3) = .Cells(ræk, 2) ActiveWorkbook.Sheets(1).Cells(11, 3) = .Cells(ræk, 3) LukXLS Exit Sub End If Next ræk End With LukXLS MsgBox ("Kundenr. " + knr + " ikke fundet") End Sub Private Sub LukXLS() xls.ActiveWorkbook.Close xls.Application.Quit Set xls = Nothing End Sub
Og hmm så en ekstra detalje. Egentlig skal den fil version jeg henter fra være låst mod redigering med en kode. Hvordan får jeg lagt ind at den sprøger mig efter den kode og ja låser igen når koden er gennemløbet.
Const dataSti = "\\sti\Versionsstyring\" Const dataFilNavn = "version.xls" Dim kNrRæk, knr, xls '<-------- er flyttet fra HentFraDataFil (fra LOKAL TIL GLOBAL)
- Har du en formular - siden du nævner CommandButton?
Det er rent esterisk. Har en masse andre commandbuttons på arket og så ser det blot pænere ud at det er ens. Men det er bestemt ikke absolut nødvendigt. Det vigtigste er at det virker.
Mange tak for hjælpen - jeg har ikke været den letteste "patient" ;O). Tak for tålmodigheden med mig.
He he nu skal jeg så løse det den modsatte vej også. Opretter et spm på det. Dvs fra versionsfilen skal alle data overføres på en gang til alle filer. Dette er i stedet for at jeg skal ind på 200 ark her i oprettelsestispunktet eller hvis jeg laver større ænsringer. Den del med at hente fra version.xls er til den løbende veligehodlelse af data.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
