Nu har jeg fundet ud af lidt af det men mangler stadig en del
Sub TestGetValue() p = "\\xxxx\xxxx\xxxxx\xxxx\Versionsstyring" f = "vedligeholdelsesark.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(5, 3) = GetValue(p, f, s, a) a = Cells(5, 4).Address Cells(8, 6) = 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
' Execute an XLM macro GetValue = ExecuteExcel4Macro(arg) End Function
Jeg står i den fil data skal overføres til. Filens navn dvs xxxxv.xls skal benyttes til at slå op efter i vedligeholdelsesarket. Dvs xxxx skal slås op i kolonne B og det er så den række der hendes data fra
Const dataSti = "C:\Documents and Settings\pb\Skrivebord\" 'tilpasses Const dataFilNavn = "dataFil" 'tilpasses 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(5, 4) = .Cells(ræk, 3) ActiveWorkbook.Sheets(1).Cells(3, 11) = .Cells(ræk, 4) Set xls = Nothing Exit Sub End If Next ræk End With Set xls = Nothing MsgBox ("Kundenr. " + knr + " ikke fundet") End Sub
ja jeg får koden til at virke med en alm kanp. Lige bortset fra at datfilen ligesom hænger bagefter - først hvis jeg genstarter maskinen kan jeg komme ind i min datafil igen og skrive. LN
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.