Consulting

Results 1 to 18 of 18

Thread: Solved: Assigning library to project via macro

  1. #1
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location

    Solved: Assigning library to project via macro

    Hello,

    I was wondering if there is as way of assigning a library to a project via excel macro.

    Instead of having to go to reference and add the library.
    /Birch81

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Just use late binding?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    Like this.
    [VBA]Set appWord = CreateObject("Word.application")[/VBA]
    /Birch81

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Yes, but also dim it as object

    [vba]

    Dim appWord As Object
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    Yes.

    I have the following.

    [vba]Global appWord As Object
    Global appDoc As Object
    Sub Transfer_to_Word()
    '____________________________________________________________________
    '^^^^^^^^^^^^^^^^^^ Open Word document ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    Set appWord = CreateObject("Word.application")
    Set appDoc = appWord.Documents.Open(Filename:=ThisWorkbook.Path & "\Tilbudsskabelon.docm")
    appWord.Visible = True
    Call AssignCells
    Call AssignBookmarks

    .
    .
    Some code
    .
    .

    '***************** Maksimize and put Word in front ******************

    appDoc.Application.WindowState = xlMaximized
    appDoc.Application.Activate

    '***************** Release objects **********************************

    Set appDoc = Nothing
    Set appWord = Nothing
    End Sub[/vba]

    But if I uncheck the Microsoft word 14.0 object library and try to run the code I get an error saying "Compiler error" - "Useer-defined type not defined"
    /Birch81

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Where do you get the error?

    Could you post the xlsm and the docm?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    BTW, I doubt you need APplication in

    [vba]

    appDoc.Application.WindowState = xlMaximized
    appDoc.Application.Activate
    [/vba]

    but you might need the window object.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    I get the error at this function

    Private Function CreateNewTable(intRows As Integer, bookmark As String) As Word.table

    Here is the Xlsm document.
    Last edited by Bob Phillips; 09-29-2010 at 11:59 AM.
    /Birch81

  9. #9
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    and the docm document.
    Last edited by Bob Phillips; 09-29-2010 at 11:58 AM.
    /Birch81

  10. #10
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    You have to remove all of the Word objects anbd variables as well

    [vba]

    Global appWord As Object
    Global appDoc As Object

    Global CellNordSyd As String
    Global CellNyTotal As Variant
    Global CellEksisTotal As Variant
    Global CellHvilTotal As Variant
    Global CellAnlaegsOmk As Variant
    Global CellAnlaegsOmkForv As Boolean
    Global CellAnlaegsOmkEnde As Boolean
    Global CellAnlaegsOmkForvRange As range
    Global CellAnlaegsOmkEndeRange As range
    Global CellEksisRettighedAntal As Variant
    Global CellTotal As Variant

    Sub Transfer_to_Word()

    '____________________________________________________________________
    '^^^^^^^^^^^^^^^^^^ Open Word document ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

    Set appWord = CreateObject("Word.application")
    Set appDoc = appWord.Documents.Open(Filename:=ThisWorkbook.Path & "\Tilbudsskabelon.docm")
    appWord.Visible = True

    Call AssignCells
    Call AssignBookmarks

    '***************** Create table for Ny installation *****************

    If CellNyTotal <> 0 And (CellHvilTotal Or CellEksisTotal) <> 0 Then
    Call CreateTable("Ny installation:", range("B21:F33"), "TblNyInst")

    ElseIf CellNyTotal <> 0 And (CellHvilTotal And CellEksisTotal) = 0 Then
    Call CreateTable("Ny installation:", range("B21:F31"), "TblNyInst")
    End If

    '***************** Create table for eksisterende installation *******

    If CellEksisTotal <> 0 And (CellHvilTotal Or CellNyTotal) <> 0 Then
    Call CreateTable("Eksisterende installation:", range("B37:F44"), "TblEksisInst")

    ElseIf CellEksisTotal <> 0 And (CellHvilTotal And CellNyTotal) = 0 Then
    Call CreateTable("Eksisterende installation:", range("B37:F42"), "TblEksisInst")
    End If

    '***************** Create table for Hvilende rettighed **************

    If CellHvilTotal <> 0 And (CellEksisTotal Or CellNyTotal) <> 0 Then
    Call CreateTable("Hvilende rettighed:", range("H21:L33"), "TblHvil")

    ElseIf CellHvilTotal <> 0 And (CellEksisTotal And CellNyTotal) = 0 Then
    Call CreateTable("Hvilende rettighed:", range("H21:L31"), "TblHvil")
    End If

    '***************** Create table for Anlægsomkostninger **************

    If CellAnlaegsOmk <> 0 And CellAnlaegsOmkForv = True And CellAnlaegsOmkEnde = False Then
    Call CreateTable("", range("B52:F52"), "TblAnlaeg")
    ElseIf CellAnlaegsOmk <> 0 And CellAnlaegsOmkEnde = True Then
    Call CreateTable("", range("B52:F52"), "TblAnlaeg")
    End If

    '***************** Create table for the total amount ****************

    If CellTotal <> 0 Then
    Call CreateTable("", range("B64:F70"), "TblTotal")
    End If

    '***************** Maksimize and put Word in front ******************

    appDoc.Application.WindowState = xlMaximized
    appDoc.Application.Activate

    '***************** Release objects **********************************

    Set appDoc = Nothing
    Set appWord = Nothing

    End Sub


    Sub AssignCells()

    CellNordSyd = ActiveWorkbook.Worksheets(1).range("C13").Value
    CellEksisRettighedAntal = ActiveWorkbook.Worksheets(1).range("C37").Value
    CellNyTotal = ActiveWorkbook.Worksheets(1).range("F33").Value
    CellEksisTotal = ActiveWorkbook.Worksheets(1).range("F44").Value
    CellHvilTotal = ActiveWorkbook.Worksheets(1).range("L33").Value
    CellAnlaegsOmk = ActiveWorkbook.Worksheets(1).range("C15").Value
    CellTotal = ActiveWorkbook.Worksheets(1).range("F70").Value
    If RangeValue(range("L39:L47")) = True And RangeValue(range("L50:L58")) = False Then
    CellAnlaegsOmkForv = True
    ElseIf RangeValue(range("L50:L58")) <> 0 Then
    CellAnlaegsOmkEnde = True
    Else
    CellAnlaegsOmkForv = False
    CellAnlaegsOmkEnde = False
    End If

    End Sub

    Sub AssignBookmarks()

    appDoc.Bookmarks("Date").range.Text = Date
    appDoc.Bookmarks("txtVedr").range.Text = ActiveWorkbook.Worksheets(1).range("B2")
    appDoc.Bookmarks("txtAngaaende").range.Text = ActiveWorkbook.Worksheets(1).range("B5")
    appDoc.Bookmarks("txtAar").range.Text = ActiveWorkbook.Worksheets(1).range("C14")
    appDoc.Bookmarks("txtPtegning").range.Text = ActiveWorkbook.Worksheets(1).range("B8")
    appDoc.Bookmarks("Date2mdr").range.Text = DateSerial(Year(Date), Month(Date) + 2, Day(Date))
    appDoc.Bookmarks("txtUser").range.Text = ActiveWorkbook.Worksheets(1).range("B11")

    End Sub

    Private Function RangeValue(range As range) As Boolean

    Dim ActiveRows As Integer
    ActiveRows = 0

    For i = 0 To range.Rows.Count 'Counts Active Rows

    If range.Cells(i, 1).Value <> "" Then
    ActiveRows = ActiveRows + 1
    Else
    ActiveRows = ActiveRows
    End If
    Next

    If ActiveRows <> 0 Then
    RangeValue = True
    Else
    RangeValue = False
    End If

    End Function

    Private Function DefineProductStrings(Text As String, Antal As Variant, Pris As Variant, InvType As String) As String

    Dim returnVal As String

    If InvType = "Ny installation:" Then

    If CellNordSyd = "NRGi Nord" Then

    Select Case Text ' Return string to table
    Case "Parcelhuse, fritidshuse, kolonihaver og erhverv. Egen stikledning"
    returnVal = "Parcelhuse, fritidshuse, kolonihaver og erhverv. Egen stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Parcelhuse, fritidshuse, kolonihaver og erhverv. Fælles stikledning"
    returnVal = "Parcelhuse, fritidshuse, kolonihaver og erhverv. Fælles stikledning." & vbCrLf & _
    "1 stk. á " & Format(Pris, "##,##") & " kr. + " & Antal - 1 & " stk. * (" _
    & Format(ActiveWorkbook.Worksheets(2).range("E16").Value, "##,##") & " kr. + (25 A * " & Format(ActiveWorkbook.Worksheets(2).range("E14").Value, "##,##") & " kr.)" & ")"
    Case "Tæt lav bebyggelse, rækkehuse. Fælles Stikledning"
    returnVal = "Tæt lav bebyggelse, rækkehuse. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Tæt lav bebyggelse, rækkehuse. Egen Stikledning"
    returnVal = "Tæt lav bebyggelse, rækkehuse. Egen stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Lejligheder >2 etager. Fælles stikledning"
    returnVal = "Lejligheder > 2 etager. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Ungdoms-, ældre- og plejebolig, højst på 65 m2. Fælles stikledning"
    returnVal = "Ungdoms-, ældre- og plejeboliger. Max 65 m2. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Enfasede installation (< 1 kW)"
    returnVal = "Enfasede installationer (< 1 kW)." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case 8
    returnVal = 0
    Case "Leveringsomfang ud over 25 ampere. Pr. ampere"
    returnVal = "Leveringsomfang ud over 25 ampere." & vbCrLf & _
    Antal & " ampere. á " & Format(Pris, "##,##") & " kr."
    Case "Pr. kW"
    returnVal = "Investeringsbidrag pr. kW." & vbCrLf & _
    Antal & " kW. á " & Format(Pris, "##,##") & " kr."
    Case "Fremtiddsikring af stikledning"
    returnVal = "Fremtidssikring af stikledning." & vbCrLf & _
    Antal & " ampere. á " & Format(Pris, "##,##") & " kr."
    Case "Total"
    returnVal = "Ialt."

    End Select

    ElseIf CellNordSyd = "NRGi Syd" Then

    Select Case Text
    Case "Parcelhuse, fritidshuse, kolonihaver og erhverv."
    returnVal = "Parcelhuse, fritidshuse, kolonihaver og erhverv." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Tæt lav bebyggelse, rækkehuse (max 2 etager)"
    returnVal = "Tæt lav bebyggelse, rækkehuse (max 2 etager)" & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Lejligheder >2 etager. Fælles stikledning"
    returnVal = "Lejligheder > 2 etager. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Ungdoms-, ældre- og plejebolig, højst på 65 m2. Fælles stikledning"
    returnVal = "Ungdoms-, ældre- og plejeboliger. Max 65 m2. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Enfasede installation (< 1 kW)"
    returnVal = "Enfasede installationer (< 1 kW)." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case 8
    returnVal = 0
    Case "Leveringsomfang ud over 25 ampere. Pr. ampere"
    returnVal = "Leveringsomfang ud over 25 ampere." & vbCrLf & _
    Antal & " ampere. á " & Format(Pris, "##,##") & " kr."
    Case "Pr. kW"
    returnVal = "Investeringsbidrag pr. kW." & vbCrLf & _
    Antal & " kW. á " & Format(Pris, "##,##") & " kr."
    Case "Total"
    returnVal = "Ialt."
    End Select

    End If

    End If

    If InvType = "Eksisterende installation:" Then

    Select Case Text
    Case "Udvidelse til ønskede rettighed (Ampere)"
    returnVal = "Udvidelse til ønskede rettighed." & vbCrLf & _
    "Fra " & CellEksisRettighedAntal & " A til " & Antal & " A til " & _
    Format(Pris, "##,##") & " kr. pr. ampere."
    Case "Fremtidssikring"
    returnVal = "Fremtidssikring af stikledning." & vbCrLf & _
    Antal & " A á " & Format(Pris, "##,##") & " kr."
    Case "Stikledningsbidrag (25 ampere)"
    returnVal = "Ved udskiftning af stikledning betales der:" & vbCrLf & _
    "Stikledningsbidrag for de første 25 A."
    Case "Ved udskiftning af stikledningbetales før udvidelsen"
    returnVal = "Der betales " & Pris & " kr. pr. ampere udover de første 25 A før udvidelsen." & vbCrLf & _
    Antal & " ampere á " & Format(Pris, "##,##") & " kr."
    Case "Total"
    returnVal = "Ialt."
    End Select

    End If

    If InvType = "Hvilende rettighed:" Then

    If CellNordSyd = "NRGi Nord" Then
    Select Case Text
    Case "Parcelhuse, fritidshuse, kolonihaver, erhverv"
    returnVal = "Parcelhuse, fritidshuse, kolonihaver og erhverv." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Tæt lav bebyggelse, rækkehuse. Fælles Stikledning"
    returnVal = "Tæt lav bebyggelse, rækkehuse. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Tæt lav bebyggelse, rækkehuse. Egen Stikledning"
    returnVal = "Tæt lav bebyggelse, rækkehuse. Egen stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Lejligheder >2 etager. Fælles stikledning"
    returnVal = "Lejligheder > 2 etager. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Ungdoms-, ældre- og plejebolig, højst på 65 m2. Fælles stikledning"
    returnVal = "Ungdoms-, ældre- og plejeboliger. Max 65 m2. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Enfasede installation (< 1 kW)"
    returnVal = "Enfasede installationer (< 1 kW)." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Leveringsomfang ud over 25 ampere. Pr. ampere"
    returnVal = "Leveringsomfang ud over 25 ampere." & vbCrLf & _
    Antal & " ampere. á " & Format(Pris, "##,##") & " kr."
    Case "Pr. kW"
    returnVal = "Investeringsbidrag pr. kW." & vbCrLf & _
    Antal & " kW. á " & Format(Pris, "##,##") & " kr."
    Case "Total"
    returnVal = "Ialt."
    End Select

    ElseIf CellNordSyd = "NRGi Syd" Then
    Select Case Text
    Case "Parcelhuse, fritidshuse, kolonihaver, erhverv"
    returnVal = "Parcelhuse, fritidshuse, kolonihaver og erhverv." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Tæt lav bebyggelse, rækkehuse (max 2 etager)"
    returnVal = "Tæt lav bebyggelse, rækkehuse (max 2 etager)" & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Lejligheder >2 etager. Fælles stikledning"
    returnVal = "Lejligheder > 2 etager. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Ungdoms-, ældre- og plejebolig, højst på 65 m2. Fælles stikledning"
    returnVal = "Ungdoms-, ældre- og plejeboliger. Max 65 m2. Fælles stikledning." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Enfasede installation (< 1 kW)"
    returnVal = "Enfasede installationer (< 1 kW)." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Leveringsomfang ud over 25 ampere. Pr. ampere"
    returnVal = "Leveringsomfang ud over 25 ampere." & vbCrLf & _
    Antal & " ampere. á " & Format(Pris, "##,##") & " kr."
    Case "Pr. kW"
    returnVal = "Investeringsbidrag pr. kW." & vbCrLf & _
    Antal & " kW. á " & Format(Pris, "##,##") & " kr."
    Case "Total"
    returnVal = "Ialt."
    End Select

    End If

    End If

    If CellAnlaegsOmk <> 0 Then
    If Text = "Anlægsomk.(c)" And CellAnlaegsOmkForv = True Then
    returnVal = "Forventede anlægsomkostninger:"
    ElseIf Text = "Anlægsomk.(c)" And CellAnlaegsOmkEnde Then
    returnVal = "Endelig anlægsomokostninger:"
    End If
    End If

    Select Case Text
    Case "Nyt investeringsbidrag. ((b+l)-d)"
    returnVal = "Nyt investeringsbidrag."
    Case "Kundeandel af anlægsomk. (k)"
    returnVal = "Kundeandel af anlægsomkostninger."
    Case "Genopretning af installationer. (fastpris)"
    returnVal = "Genopretning af installationer." & vbCrLf & _
    Antal & " stk. á " & Format(Pris, "##,##") & " kr."
    Case "Total ex. moms."
    returnVal = ""
    Case "Total ex. moms."
    returnVal = ""
    Case "25 % moms"
    returnVal = "25 % moms."
    Case "Total Incl. moms"
    returnVal = "Ialt."
    End Select

    DefineProductStrings = returnVal

    End Function



    Private Function CreateNewTable(intRows As Integer, bookmark As String) As Object
    ' add a reference to the Word-library
    Dim wrdTable As Object
    Set wrdRange = appDoc.Bookmarks(bookmark).range
    ' appWord.Visible = True
    'Create table
    Set wrdTable = appDoc.Tables.Add(range:=wrdRange, NumRows:=intRows, NumColumns:=3)

    'Set table width
    wrdTable.Columns(3).Width = 70
    wrdTable.Columns(2).Width = 20
    wrdTable.Columns(1).Width = 320

    Set CreateNewTable = wrdTable

    End Function

    Sub CreateTable(strHeader As String, colRange As range, bookmark As String)

    Dim table As Object
    Dim ActiveRows As Integer
    Dim offSetRow As Integer
    Dim rowCounter As Integer
    Dim cellCounter As Integer
    Dim krCounter As Integer
    Dim sum As String
    Dim dummy As String
    Dim productType As String
    Dim test As Integer
    ActiveRows = 0
    krCounter = 0
    cellCounter = 1
    offSetRow = 1
    rowCounter = 1


    If strHeader <> "" Then
    ActiveRows = 1
    Else
    ActiveRows = 0
    End If



    For i = 0 To colRange.Rows.Count 'Counts Active Rows

    If colRange.Cells(i, 5).Value <> "" And colRange.Cells(i, 5).Value <> 0 Then
    ActiveRows = ActiveRows + 1
    Else
    ActiveRows = ActiveRows
    End If
    Next

    Set table = CreateNewTable(ActiveRows, bookmark) 'Create Table

    With table 'Insert Header string
    If strHeader <> "" Then
    With .Cell(1, 1).range
    .InsertAfter strHeader
    .Underline = 1
    offSetRow = 2
    End With
    End If


    For Each Cell In colRange

    Select Case True
    Case cellCounter Mod 5 = 0 'if cellcounter modolus 5 = 0 transfer activecell value to sum
    sum = Cell
    Case cellCounter Mod 4 = 0
    dummy = Cell
    Case cellCounter Mod 3 = 0
    price = Cell
    Case cellCounter Mod 2 = 0
    nummer = Cell
    Case cellCounter Mod 1 = 0
    productType = Cell
    End Select

    If cellCounter Mod 5 = 0 Then
    If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
    With .Cell(offSetRow, 1).range
    .InsertAfter DefineProductStrings(productType, nummer, price, strHeader) 'Insert string text
    End With
    With .Cell(offSetRow, 2).range
    If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt." Then

    .InsertAfter "kr. "
    If bookmark <> "TblTotal" Then
    If strHeader <> "" Then
    If ActiveRows = offSetRow And ActiveRows <> 2 Then 'Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1

    End If
    End If
    ElseIf bookmark = "TblTotal" Then
    If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1

    ElseIf ActiveRows = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
    .ParagraphFormat.Borders(-3).LineStyle = 7

    End If
    End If

    Else
    .InsertAfter " - "

    If bookmark = "TblTotal" Then
    If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1
    End If
    End If

    End If
    krCounter = krCounter + 1
    End With

    With .Cell(offSetRow, 3).range
    If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt." Then

    .InsertAfter Format(sum, "##,##0.00") 'Insert sum
    ' .ParagraphFormat.Alignment = wdAlignParagraphRight
    .ParagraphFormat.Alignment = 2

    If bookmark <> "TblTotal" Then
    If strHeader <> "" Then
    If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1
    End If
    End If
    ElseIf bookmark = "TblTotal" Then
    If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1
    ElseIf ActiveRows = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
    .ParagraphFormat.Borders(-3).LineStyle = 7
    End If
    End If

    Else
    .InsertAfter Format(sum, "##,##0.00") 'Insert sum
    .ParagraphFormat.Alignment = wdAlignParagraphRight
    If bookmark = "TblTotal" Then
    If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then

    ' .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .ParagraphFormat.Borders(-3).LineStyle = 1

    End If
    End If

    End If
    End With
    End If

    cellCounter = 0
    If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
    offSetRow = offSetRow + 1
    Else
    offSetRow = offSetRow
    End If
    End If


    cellCounter = cellCounter + 1
    Next

    rowCounter = rowCounter + 1

    For Each myRow In .Rows
    For Each myCell In myRow.Cells
    myCell.TopPadding = Application.CentimetersToPoints(0)
    myCell.BottomPadding = Application.CentimetersToPoints(0)
    myCell.LeftPadding = Application.CentimetersToPoints(0)
    myCell.RightPadding = Application.CentimetersToPoints(0)
    Next
    Next

    End With
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  11. #11
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    When using late binding methods, constants should be set as a number. A easy way to see what the number would be is to use early binding for development and type it into the Immediate Window. e.g.
    ?AppDoc.xlMaximized

    So that I can use MSWord constants as a word rather than the number, I do something like this:
    [VBA] wdReplaceAll = 2
    wdFindContinue = 1[/VBA]

    I will look at your code in detail if this tip does not help you.

  12. #12
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    I seems to work xld.

    Just so I understand. When I send information to work I haft to assign constants to object and not a variable. is that correct?

    eksampel.

    I can´t align in this way.
    [VBA].ParagraphFormat.Alignment = wdAlignParagraphRight

    But I haft to align in this way.

    .ParagraphFormat.Alignment = 2
    [/VBA]

    Thanks for the help.
    /Birch81

  13. #13
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Quote Originally Posted by Birch81
    I seems to work xld.

    Just so I understand. When I send information to work I haft to assign constants to object and not a variable. is that correct?

    eksampel.
    You have the right idea, but the wrong terminology. You cannot use application constants (apart from the host application), as you are not bound to the application's type library, but you have to use the constant's value.

    Quote Originally Posted by Birch81
    I can´t align in this way.
    [VBA].ParagraphFormat.Alignment = wdAlignParagraphRight

    But I haft to align in this way.

    .ParagraphFormat.Alignment = 2
    [/VBA]

    Thanks for the help.
    That is correct, but a better way is to declare some constants of your own for wdAlignParagraphRight and so on, as Kenneth suggested.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  14. #14
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    Okay. That helps alot.

    Thank you very much for the help again

    Is it possible for me to delete those to attached files?
    /Birch81

  15. #15
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Press the "Edit" button. down and to the right of the post you made with the files attached. You can delete attachments by going to GO Advanced>Manage Attachments. There is a button to delete the attachment.
    Peace of mind is found in some of the strangest places.

  16. #16
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    Yeah but I can only edit my last post?
    /Birch81

  17. #17
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    It seems I can delete them, so I did it for you.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  18. #18
    VBAX Regular
    Joined
    Apr 2010
    Posts
    46
    Location
    Thank you very much

    And thanks for the help.
    /Birch81

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •