Import af tekstboks fra Excel til Access

Tekstbokse i regnearket - er det i en formular / kontrolelement / formularfelt eller.. og hvor skal teksten hen?

Er det en automatisk løsning med VBA du søger - eller ren manuel?

Jeg har desværre lynende travlt, så jeg har bare pastet noget kode, som jeg har brugt til noget import af excel og der er noget med specifikke celler. Så held og lykke og håber du kan bruge noget af det!~)

Private Sub Hentfiler_Click()
Dim sql As String
Dim strSQL As String
Dim db As DAO.Database
Dim aar As String

sql = "DELETE tblFilnavn.*" & _
"FROM tblFilnavn;"

DoCmd.RunSQL sql
aar = Me.aar

    Set db = CurrentDb()
   
    strSQL = "DELETE * FROM tblfilnavn"

        db.Execute strSQL
   
    'Udviklingsdrev
    FileSearch_EXCELL "O:\JL\Excel\Status\Antal stk. -kg\" & aar, "*.xls", "O:\Databaser\StatusData\StatusData.mdb", "tblfilnavn", "filnavn"
     
   
End Sub

Public Function AflæsfelterIExcel()
On Error Resume Next

    Dim Xl As Object
    Dim rsKunde As New ADODB.Recordset
    Dim rsFiler As New ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim a As String
   
    Set cn = CurrentProject.Connection
    Set Xl = CreateObject("EXCEL.APPLICATION")
    a = Me.a
   
    rsKunde.Open "status", cn, adOpenKeyset, adLockOptimistic
    rsFiler.Open "tblFilnavn", cn, adOpenStatic
   
    Do Until rsFiler.EOF
        Xl.Workbooks.Open rsFiler!filnavn, False, True
        rsKunde.AddNew
        Xl.Sheets("Samlet").SELECT
        rsKunde![Produkt] = Xl.range(a & "6")
        rsKunde!KgPrKar = Xl.range(a & "10")
        rsKunde!Vandprocent = Xl.range(a & "15")
        rsKunde!Uge = Xl.range("B1")
        rsKunde!aar = Me.aar

        rsKunde.Update
        rsFiler.MoveNext

        Xl.Quit
        SendKeys "%{n}", True
               
                                     
    Loop

End Function

Det er ikke i en formular, og det er heller ikke et formularfelt.

Det er sådan en tekstboks som man får når man vælger "Tekstboks" på værktøjslinien "Tegning".

Det er en automatisk løsning i VBA jeg er ude efter.

Hvordan ser din kode ud p.t. - dette nfor at få en opfattelse af "kontexten" - idet jeg går ud fra, at koden ligger i Access og du på en eller anden måde udvælger regnearksfilen. Er det det samme regneark hver gang?

Hvis det er lettere kan du evt. sende såvel database som excel-fil til: pb@supertekst-it.dk

Jeg kan ikke sende regneark og access-fil, da det er fortroligt. Men koden er følgende (jeg er ikke prof-programmør, så det er tilladt at grine ;o) :

Private Sub hentdata_Click()

'Regnearksfanerne er navngivet med ugedagene
ugeDagNr = Weekday(Forms!f_basis_menu!driftsdoegn, vbMonday)
Select Case ugeDagNr
    Case 1
    ugeDag = "Mandag"
    Case 2
    ugeDag = "Tirsdag"
    Case 3
    ugeDag = "Onsdag"
    Case 4
    ugeDag = "Torsdag"
    Case 5
    ugeDag = "Fredag"
    Case 7
    ugeDag = "Lørdag-søndag"
End Select

'Hent oplysninger fra hovedmenuen om den aktuelle driftsenhed
center = Forms!f_basis_menu!enhed
ddoegn = Forms!f_basis_menu!driftsdoegn
ugeNr = DLookup("uge_nr", "t_basis", "driftsdoegn=#" & Year(ddoegn) & "/" & Month(ddoegn) & "/" & Day(ddoegn) & "#")
'Hent data fra regneark
sti = "X:\data\End-to-End-Processer\Kvalitet og Transport\Rapportering\datakilder\khc\import\uge " & ugeNr & ".xls"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "t_temp", sti, no, ugeDag & "!I25:I25"
'Gem i databasen og slet den midlertidige tabel
DoCmd.SetWarnings False
DoCmd.RunSQL ("UPDATE t_rap_ank_center SET std_mask_a=" & DLookup("F1", "t_temp") & " WHERE center='" & center & "' AND driftsdoegn=#" & Year(ddoegn) & "/" & Month(ddoegn) & "/" & Day(ddoegn) & "#;")
DoCmd.RunSQL ("DROP TABLE t_temp")
DoCmd.SetWarnings True

End Sub

Regnearksfilen er navngivet efter ugenummer, og de enkelte ugedage ligger som faner i den.

OK - vil se på det

Her er en kode, der vil kunne identificere tekstbokse og udtrække indholdet - du må selve placere koden korrekt
- giv blot signal, hvis behov for mere info.:

Rem Sæt referencen: Microsoft Excel 9.0 Object Library (Tools / References i VBA)

Dim xls As Object, antal, s, stext As String

Set xls = CreateObject("Excel.application")
With xls
    .Workbooks.Open (sti)
   
Rem Antallet af tekstbokse
    antal = .ActiveSheet.Shapes.Count
   
Rem gennemløb alle tekstbokse og hent teksten herfra
    For s = 1 To antal
        .ActiveSheet.Shapes(s).Select
        stext = Selection.Characters.Text
       
Rem Overfør til tabel-felt
    Next s

Rem Luk objectets applikation & nedlæg objectet
    .Application.Quit
    Set xls = Nothing
End With
Rem ==================================================

Tak for det.

Hvordan får jeg den til at sætte et bestemt sheet som ActiveSheet?

Fandt ud af at jeg skulle bruge:

.Sheets("Briefing").select

Men stext er tom.

Så virker den :)

Rem Sæt referencen: Microsoft Excel 9.0 Object Library (Tools / References i VBA)

Dim xls As Object, antal, s, stext As String
On Error Resume Next
Set xls = CreateObject("Excel.application")
With xls
    .Workbooks.Open (sti)
    .Sheets("Briefing").select

Rem Antallet af tekstbokse
    antal = .ActiveSheet.Shapes.Count
   
Rem gennemløb alle tekstbokse og hent teksten herfra
    For s = 1 To antal
        stext = .ActiveSheet.Shapes(s).textframe.characters.Text
        DoCmd.RunSQL ("INSERT INTO t_test (tekst) VALUES('test: " & stext & "')")
Rem Overfør til tabel-felt
    Next s

Rem Luk objectets applikation & nedlæg objectet
    .Application.Quit
    Set xls = Nothing
End With

Selv tak... "og så er der ikke noget at grine af" :-)