VB6 - Spreadsheet "MergeCells" not working

Question

tgifgemini 12 Junior Poster

17 Years Ago

Hello everybody,
My objective is to split a record, write 90% of the record on one row and write the remaining 10% on the next row(right underneath the other half). The spreadsheet was formated exactly the way I want it.

Now I am using similar code and technique to format another spreadsheet, but it is not working. Maybe there is something I'm doing incorrectly on the code.

I have attached two spreadsheets: The first spreadsheet is correctly formated and the second is not formating correctly( Unformated) I want to format the second spreadsheet to look like the first.

See my module below:

ii = 5
    w = 0
    For Each R In xlWksht.Range("A13:M13"): w = w + R.ColumnWidth: Next
    
    rht = xlWksht.Range("A6").RowHeight
    
    Do Until M.qBW.EOF = True
        ii = ii + 2
        xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
        xlWksht.Cells(ii, 2).Value = M.qBW![Description]
        xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
        xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

        SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
        End If
        
        xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
        xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
        xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
        xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
        xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments]))
        
        M.qBW.MoveNext
    Loop
    
    With xlWksht.Range(Cells(ii + 1, 1), Cells(ii + 1, 13))
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .IndentLevel = 0
            .MergeCells = True
            .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 1).text) - Len("Comments:")) / w + rht + (rht - .Font.Size)
    End With

Thanks,
tgifgemini.

visual-basic

This attachment is potentially unsafe to open. It may be an executable that is capable of making changes to your file system, or it may require specific software to open. Use caution and only open this attachment if you are comfortable working with zip files.

Formated_Sprdsht1.zip (0.13 KB)

This attachment is potentially unsafe to open. It may be an executable that is capable of making changes to your file system, or it may require specific software to open. Use caution and only open this attachment if you are comfortable working with zip files.

Unformated_Sprdsht1.zip (44.42 KB)

1 Contributor
2 Replies
166 Views
2 Days Discussion Span
Latest Post 17 Years Ago Latest Post by tgifgemini

Reply to this topic

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

tgifgemini 12 Junior Poster · Answer 1 · 2007-08-24T22:30:25+00:00

Does any of you good people have an idea why my spreadsheet is not formating properly? I have tweaked and tweaked but I'm not getting any positive result. My desire is to display all the records just like the first record.
Please see attachment for the sample of my spreadsheet.
Thanks.

Below is my entire Module:

ii = 5
    w = 0
    For Each R In xlWksht.Range("A13:M13"): w = w + R.ColumnWidth: Next
    
    rht = xlWksht.Range("A6").RowHeight
    
    Do Until M.qBW.EOF = True
        ii = ii + 2
        xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
        xlWksht.Cells(ii, 2).Value = M.qBW![Description]
        xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
        xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

        SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
        End If
        
        xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
        xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
        xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
        xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
        xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments]))
        M.qBW.MoveNext
    Loop
    
    With xlWksht.Range(Cells(ii + 1, 1), Cells(ii + 1, 13))
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .IndentLevel = 0
            .Font.Size = 9
            .MergeCells = True
            .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 1).text) - Len("Comments:")) / w + rht + (rht - .Font.Size)
    End With

Thanks,
tgifgemini.

tgifgemini 12 Junior Poster · Answer 2 · 2007-08-25T04:53:39+00:00

Thanks folks. Someone pointed out that I a code was outside the loop, thereby not executing.
You all enjoy your weekend.
tgifgemini.