Keresés

Új hozzászólás Aktív témák

  • Kobe

    veterán

    válasz Mutt #17741 üzenetére

    helló

    köszi a tippet, így működik

    Viszont az egyik makróm továbbra sem akar tökéletesen funkcionálni:

    Function OpenformatSWP()
    Dim objexcel As Object
    Dim objworkbook As Object
    Dim CodeMod As Object
    Dim LineNum2 As Long
    Dim Code3 As String
    Const DQUOTE = """" ' one " character
    Dim destination2 As String

    destination2 = "C:\Users\test\swp\test.xls"

    Set objexcel = CreateObject("Excel.Application")
    objexcel.Visible = True
    objexcel.DisplayAlerts = False

    Set objworkbook = objexcel.Workbooks.Open(destination2)
    Set CodeMod = objworkbook.VBProject.VBComponents("Sheet1").CodeModule

    Code3 = ""
    Code3 = Code3 & " Dim lngLastRow" & vbNewLine
    Code3 = Code3 & " lngLastRow = Cells(Rows.Count, ""A"").End(xlUp).Row" & vbNewLine
    Code3 = Code3 & " Columns(""X:X"").Select" & vbNewLine
    Code3 = Code3 & " Selection.Insert Shift:=xlToRight" & vbNewLine & vbNewLine
    Code3 = Code3 & " Range(""X1"").Select" & vbNewLine
    Code3 = Code3 & " ActiveCell.FormulaR1C1 = ""common_id""" & vbNewLine & vbNewLine
    Code3 = Code3 & " Range(""X2"").Select" & vbNewLine

    With CodeMod
    LineNum2 = .CreateEventProc("Change", "Worksheet")
    LineNum2 = .VBE.MainWindow.Visible = False
    LineNum2 = LineNum2 + 1
    .InsertLines LineNum2, Code3

    End With
    objworkbook.Save
    objworkbook.close
    'reopen Excel to run autostart
    objexcel.Workbooks.Open (destination2)
    End Function

    ezt a functiont futtatom accessből, és az volna a cél, hogy a test.xls file első munkalapjára beszúrjon és futtasson egy kódot.

    Perpillanat accessben Runtime error 40063 as hibával leáll a makró ennél a sornál:

    LineNum2 = .CreateEventProc("Change", "Worksheet")

    Az excel fileban is elég érdekes az eredmény, a Code3 ként definiált kódot egyszerűen nem a Sub / End Sub közé szúrja be, hanem elé. Sorról sorra így néz ki az Excelben megjelenő kód:

    Dim lngLastRow
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "common_id"
    Range("X2").Select
    Private Sub Worksheet_Change(ByVal Target As Range)
    End Sub

Új hozzászólás Aktív témák

Hirdetés