Adresse på celle i et OLE Excel Ark

Sub CellNumRowNum()
MsgBox "Kolonne-, row-nummer  " & ActiveCell.Column & ", " & ActiveCell.Row
End Sub

Mange tak for dit forsøg - men desværre det kan man desværre ikke, når der er tale om et OLE-objekt. Jeg har selv prøvet!
Man kan skrive til en celle ved:

Dim xlBook1 As Excel.Workbook
Set xlBook1 = OLE1.object
xlBook1.Sheets(1).Cells(1, 1) =  "Hej"

Tilsyneladende kender VB ikke noget til Activecell inde i OLE objektet.
Men har du andre bud, så meld endelig tilbage !

Michael

Hjælper dette her ?

Sub Makro2()
Dim objExcel As Excel.Application
Dim objWrkBk As Excel.Workbook
Dim objSheet As Object

' Create an instance of Excel and make it visible
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.WindowState = xlNormal

' Add a workbook to Excel to work with and get a reference to the active Sheet
Set objWrkBk = objExcel.Workbooks.Add
Set objSheet = objWrkBk.ActiveSheet

' Add values to the sheet
objSheet.Cells(1, 1).Value = "Column Header 1"
objSheet.Cells(1, 2).Value = "Column Header 2"
objSheet.Cells(1, 3).Value = "Column Header 3"
objSheet.Cells(2, 1).Value = "Value 1"
objSheet.Cells(2, 2).Value = "Value 2"
objSheet.Cells(2, 3).Value = "Value 3"

' Save the workbook, then close Excel
objWrkBk.SaveAs "C:\TEST.XLS"
objWrkBk.Close
objExcel.Quit

' Clean up memory
Set objSheet = Nothing
Set objWrkBk = Nothing
Set objExcel = Nothing
Exit Sub

ErrorTrap:

MsgBox "The following error occured:" & vbCrLf & vbCrLf & _
"Error Number = " & Err.Number & vbCrLf & _
"Error Source = " & Err.Source & vbCrLf & _
"Error Descirption = " & Err.Description, vbExclamation, " Error"
Err.Clear

Set objSheet = Nothing
Set objWrkBk = Nothing
Set objExcel = Nothing

End Sub

Mange tak for budet, men:
Jeg kan stadig ikke se den active celle fra VB. Du starter Excel op og fra dennes vba-kode kan man sikkert aflæse den active celle, men jeg vil gerne kunne se den aktive celle fra VB.

Sorry

Michael

Men ved nærmere efter tanke kan jeg bruge godt bruge din kode.
Den skal bare modificeres til at ÅNBE et bestemt ark, som jeg skal redigere mine data i. Så slipper jeg nemlig for OLE-objektet, som alligevel ikke virker efter hensigten
Det må kunne laves.
Så selvom du ikke har svaret på det oprindelige spørgsmål, så kan du godt få pointene, hvis bare du kan modificer din kode til at åbne et workbook, som ligger på mit c-drev.
Jeg har selv prøvet men det virker desværre ikke:

Sub Makro2()
Dim objExcel As Excel.Application
Dim objWrkBk As Excel.Workbook
Dim objSheet As Object

' Create an instance of Excel and make it visible
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.WindowState = xlNormal

' Add a workbook to Excel to work with and get a reference to the active Sheet
Set objWrkBk = Workbooks.Open Filename:= _
        "C:\Documents and Settings\mko\Skrivebord\excelSht.xls"
Set objSheet = objWrkBk.ActiveSheet

' Add values to the sheet
objSheet.Cells(1, 1).Value = "Column Header 1"
objSheet.Cells(1, 2).Value = "Column Header 2"
objSheet.Cells(1, 3).Value = "Column Header 3"
objSheet.Cells(2, 1).Value = "Value 1"
objSheet.Cells(2, 2).Value = "Value 2"
objSheet.Cells(2, 3).Value = "Value 3"

' Save the workbook, then close Excel
objWrkBk.SaveAs "C:\TEST.XLS"
objWrkBk.Close
objExcel.Quit

' Clean up memory
Set objSheet = Nothing
Set objWrkBk = Nothing
Set objExcel = Nothing
Exit Sub

ErrorTrap:

MsgBox "The following error occured:" & vbCrLf & vbCrLf & _
"Error Number = " & Err.Number & vbCrLf & _
"Error Source = " & Err.Source & vbCrLf & _
"Error Descirption = " & Err.Description, vbExclamation, " Error"
Err.Clear

Set objSheet = Nothing
Set objWrkBk = Nothing
Set objExcel = Nothing

End Sub

Så skulle den være der ?

Sub Makro2()
Dim objExcel As Excel.Application
Dim objWrkBk As Excel.Workbook
Dim objSheet As Object
Set objExcel = CreateObject("Excel.Application")


' Open file
Set objWorkbook = objExcel.Workbooks.Open("C:\Documents and Settings\mko\Skrivebord\excelSht.xls")
objExcel.Visible = True
Set objWorksheet = objExcel.Worksheets(2)
objWorksheet.Activate

' Add values to the sheet
objWorksheet.Cells(1, 1).Value = "Column Header 1"
objWorksheet.Cells(1, 2).Value = "Column Header 2"
objWorksheet.Cells(1, 3).Value = "Column Header 3"
objWorksheet.Cells(2, 1).Value = "Value 1"
objWorksheet.Cells(2, 2).Value = "Value 2"
objWorksheet.Cells(2, 3).Value = "Value 3"

' Save the workbook, then close Excel
objWorkbook.SaveAs "C:\TEST.XLS"
objWorkbook.Close
objExcel.Quit

' Clean up memory
Set objSheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Exit Sub

ErrorTrap:

MsgBox "The following error occured:" & vbCrLf & vbCrLf & _
"Error Number = " & Err.Number & vbCrLf & _
"Error Source = " & Err.Source & vbCrLf & _
"Error Descirption = " & Err.Description, vbExclamation, " Error"
Err.Clear

Set objSheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

End Sub

sub'en kører indtil
Set objWorksheet = objExcel.Worksheets(2)
så fejlen den. Kan du rette det?

Excel med den rette bog blev åbnet :-)

Michael

Hej Michael

Set objWorksheet = objExcel.Worksheets(2) Der vil den åbne Ark 2

Du skal ændre Worksheets(2) til det din faneblad hedder.

Hjalp dette ?

Hvis dit faneblad hedder Moms så skriv

Set objWorksheet = objExcel.Worksheets("Moms")

Det er mig der har sovet.
Min fil, som skulle åbnes åbnede automatisk et anden fil og aktiverede et chart i denne.
Derfor fejlede din makro.

Flot arbejde !!
Du for point og karma.
Hvis du skulle finde ud af  det oprindelige spørgsmål, så er der 100 nye point at  hente.

Michael

THX for de fine ord

Er det her svar på oprindelige spørgsmål ?

Sub Main()
    Dim oExcel As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oWS As Excel.Worksheet
   
    Set oExcel = New Excel.Application
       
    Dim oRng1 As Excel.Range
    Dim oRng2 As Excel.Range

    Set oWB = oExcel.Workbooks.Add
    Set oWS = oWB.Worksheets("Ark1")

    Set oRng1 = oWS.Range("A1")
    Set oRng2 = oWS.Range("B2:E5")

    oRng1.Value = "Test again"
    Call oRng1.Copy(Destination:=oRng2)

    oWB.SaveAs ("Test.xls") ' <-- Gem fil som Test

Cleanup:
    Set oWS = Nothing
    If Not oWB Is Nothing Then oWB.Close
    Set oWB = Nothing
    oExcel.Quit
    Set oExcel = Nothing
End Sub

Så nu skulle den endelig være hjemme !

Sub Makro1()
Dim oExcel As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oWS As Excel.Worksheet
   
    Set oExcel = New Excel.Application
       
    Dim oRng1 As Excel.Range
    Dim oRng2 As Excel.Range

    Set oWB = oExcel.Workbooks.Add
    Set oWS = oWB.Worksheets("Ark1")

    Set oRng1 = oWS.Range("A10")
    Set oRng2 = oWS.Range("B2:E5")

    oRng1.Value = "Test again"
    Call oRng1.Copy(Destination:=oRng2)
    oExcel.ActiveCell.Offset(10, 10).Select
    oExcel.ActiveCell.Formula = "TEST ACTIVECELL"
    oExcel.ActiveCell.Offset(-5, -5).Select
    oExcel.ActiveCell.Formula = ActiveCell.Column & ", " & ActiveCell.Row

    oWB.SaveAs ("Test.xls") ' <-- Gem fil som Test

Cleanup:
    Set oWS = Nothing
    If Not oWB Is Nothing Then oWB.Close
    Set oWB = Nothing
    oExcel.Quit
    Set oExcel = Nothing

End Sub

Stærkt !! fremravende.
Jeg ser først nu det svar.

Vil du ikke have 50 ekstra ?

Michael

Undskyld ! Jeg har lovet 100 så send for guds skyld et svar.

Michael

Der er ikke mulighed for at give et svar, kun kommentar ?

rabitjosph> http://www.eksperten.dk/spm/791998