Cần giúp đỡ viết code VBA ẩn dòng trống ko có dữ liệu và co dòng vừa trong trang >> (2 người xem)

alibaba2209 · 12/7/15

doveandrose đã viết:
đừng kêu tôi là sư phụ . tôi nghe nhức đầu . tôi cũng chỉ giống như bạn đã từng gặp vấn đề đã từng hỏi . giờ tôi có tí kinh nghiệm thì tôi giúp lại người khác . nguyên A4 là cái gì ? không hiểu .
số đó phải là 72 đó tôi viết nhầm . nó là hệ số chuyển đơn vị từ inches sang points
1 inches = 72 points
trong file bạn đưa lên có 2 sheet mà tôi thấy đã khác xa nhau về cấu trúc thì làm sao tôi dám viết code áp dụng trên mọi sheet

ý mình là điền luôn khổ trang A4 vào code chứ ko ghi ở ngoài sheet chỗ ô J5 ý

doveandrose · 12/7/15

alibaba2209 đã viết:
ý mình là điền luôn khổ trang A4 vào code chứ ko ghi ở ngoài sheet chỗ ô J5 ý

Mã:

pageHei = 11.7 * 72 - .PageSetup.TopMargin - .PageSetup.BottomMargin

alibaba2209 · 12/7/15

Let'GâuGâu đã viết:
nhiều chuyện chút nha đai ca........hihihihi
sao đai ca ko lấy thông số page setup vào luôn mà phải nhập tay
chơi luôn cho "ló máu"..........hihihihii

ùa! mình cũng đang muốn add luôn vào code

alibaba2209 · 12/7/15

doveandrose đã viết:
đừng kêu tôi là sư phụ . tôi nghe nhức đầu . tôi cũng chỉ giống như bạn đã từng gặp vấn đề đã từng hỏi . giờ tôi có tí kinh nghiệm thì tôi giúp lại người khác . nguyên A4 là cái gì ? không hiểu .
số đó phải là 72 đó tôi viết nhầm . nó là hệ số chuyển đơn vị từ inches sang points
1 inches = 72 points
trong file bạn đưa lên có 2 sheet mà tôi thấy đã khác xa nhau về cấu trúc thì làm sao tôi dám viết code áp dụng trên mọi sheet

Đúng rồi 2 sheet khác nhau! mình muốn hỏi để khi mình tách riêng sheet đó ra và tạo thành nhiều sheet cấu trúc giống nhau nên mình muốn hỏi làm thế nào để cho chạy tất cả các sheet

doveandrose · 12/7/15

Let'GâuGâu đã viết:
nhiều chuyện chút nha đai ca........hihihihi
sao đai ca ko lấy thông số page setup vào luôn mà phải nhập tay
chơi luôn cho "ló máu"..........hihihihii

mình còn trẻ lắm nha bạn . mới đầu 2 thôi . gọi mình là đại ca mình không biết trốn vào đâu nữa =))
mình sợ người này không sửa được code khi cần in trên khổ giấy khác . nếu A4 hết thì khỏe rồi

alibaba2209 · 12/7/15

doveandrose đã viết:
mình còn trẻ lắm nha bạn . mới đầu 2 thôi . gọi mình là đại ca mình không biết trốn vào đâu nữa =))
mình sợ người này không sửa được code khi cần in trên khổ giấy khác . nếu A4 hết thì khỏe rồi

Cảm ơn bạn nhé! mình vọc cũng hiểu qua qua 1 chút code của bạn viết.. giờ muốn cho chạy nhiều sheet thì thay đổi như nào nhỉ

doveandrose · 12/7/15

alibaba2209 đã viết:
Đúng rồi 2 sheet khác nhau! mình muốn hỏi để khi mình tách riêng sheet đó ra và tạo thành nhiều sheet cấu trúc giống nhau nên mình muốn hỏi làm thế nào để cho chạy tất cả các sheet

thế thì bạn phải đưa file nào đó lên và chỉ rõ các sheet có cấu trúc giống nhau đó có quy luật gì về tên gọi
thí dụ các sheet cần chỉnh sẽ có tên có dạng "1.Kxx" chẳng hạn
hoặc là tất cả các sheet cần chỉnh cùng nằm trên 1 file . sheet nào có cấu trúc khác thì tự bạn đem đi qua file khác mà đặt

alibaba2209 · 12/7/15

doveandrose đã viết:
thế thì bạn phải đưa file nào đó lên và chỉ rõ các sheet có cấu trúc giống nhau đó có quy luật gì về tên gọi
thí dụ các sheet cần chỉnh sẽ có tên có dạng "1.Kxx" chẳng hạn
hoặc là tất cả các sheet cần chỉnh cùng nằm trên 1 file . sheet nào có cấu trúc khác thì tự bạn đem đi qua file khác mà đặt

1. Đây bạn ơi! đây là 1 file nhiều sheet giống nhau.
mình muốn 1 kiểu nữa như này:
2. Nếu muốn chạy các sheet theo ý mình theo kiểu mục lục, giống như lúc đầu đặt khổ giấy A4 ở ô J5 đó

doveandrose · 12/7/15

alibaba2209 đã viết:
1. Đây bạn ơi! đây là 1 file nhiều sheet giống nhau.
mình muốn 1 kiểu nữa như này:
2. Nếu muốn chạy các sheet theo ý mình theo kiểu mục lục, giống như lúc đầu đặt khổ giấy A4 ở ô J5 đó

ý 1 thì để từ từ nha vì nếu vùng in lên tới dòng 207 thì code có khi chạy sai đó . để mai tính giờ tôi buồn ngủ rồi -+*/

ý 2 tôi không hiểu bạn . cần nói rõ hơn

Let'GâuGâu · 12/7/15

doveandrose đã viết:
mình còn trẻ lắm nha bạn . mới đầu 2 thôi . gọi mình là đại ca mình không biết trốn vào đâu nữa =))
mình sợ người này không sửa được code khi cần in trên khổ giấy khác . nếu A4 hết thì khỏe rồi

tuổi trẻ tài cao, tôi mới double bạn thui, kêu đai ca là được rồi........hehehheh
lúc trước tôi có thấy đoạn code này, bạn thử xem nó có xài được ko

Mã:

hgWid = Application.InchesToPoints(ActiveSheet.PageSetup.PaperSize)

alibaba2209 · 12/7/15

doveandrose đã viết:
ý 1 thì để từ từ nha vì nếu vùng in lên tới dòng 207 thì code có khi chạy sai đó . để mai tính giờ tôi buồn ngủ rồi
ý 2 tôi không hiểu bạn . cần nói rõ hơn

ý 1: là muốn code chạy all sheet trong file cell, còn dòng lên tới 207 nghĩa là mình đã chép code sang file khác và tùy chỉnh vùng lựa chọn thôi
ý 2: là mình muốn code chạy cho 1 số sheet, có tên có dạng "1.Kxx" chẳng hạn có ảnh minh họa
nhầm chút nhé.. Tên các sheet muốn code chạy

doveandrose · 13/7/15

Let'GâuGâu đã viết:
tuổi trẻ tài cao, tôi mới double bạn thui, kêu đai ca là được rồi........hehehheh
lúc trước tôi có thấy đoạn code này, bạn thử xem nó có xài được ko

Mã:

hgWid = Application.InchesToPoints(ActiveSheet.PageSetup.PaperSize)

cám ơn bạn nhưng rất tiếc ....
cái PageSetup.PaperSize là người ta dùng số để đại diện cho cái khổ giấy đang được chọn (ở đây là số 9 )
giống như kiểu range.end(3) được hiểu là range.end(xlup) (hay down gì đó )
chứ VBA tôi không tìm ra được hàm nào để lấy ra chiều dài và chiều rộng của tờ giấy in

AsP1tGE1nQRlKetHrdFPeP5ptzeSRmogwW4O1P51Xrg=w1167-h665-no

alibaba2209 · 13/7/15

bạn ơi! giúp mình bài #31 với!

doveandrose · 13/7/15

làm vầy thì khỏi cần biết dòng cuối trong bảng là 207 hay bao nhiêu , cứ nhắm mắt đưa chân thôi

Mã:

Sub pagsetup()
Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long
Application.ScreenUpdating = False
Set shNames = Worksheets("Sheet1").Range("B1:B" & Worksheets("Sheet1").Range("B50000").End(xlUp).Row)
For Each ws In Worksheets
    If TypeName(Application.Match(ws.Name, shNames, 0)) <> "Error" Then
        With ws
            ws.Activate
            lrPrint = .[B50000].End(xlUp).Row
            .Range("A1:A" & lrPrint).EntireRow.Hidden = False
            arr = .Range("B1:D" & lrPrint).Value
            For r = UBound(arr) To 1 Step -1
                If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
                If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
                    lrCT = r
                    Exit For
                End If
            Next
            .PageSetup.PrintArea = "B1:G" & (lrPrint + 200)
            ActiveWindow.View = xlPageBreakPreview
            frCT = .Rows(.PageSetup.PrintTitleRows).Row + .Rows(.PageSetup.PrintTitleRows).Rows.Count
            .Rows(frCT & ":" & lrPrint).RowHeight = 14
            If lrCT < signRow - 1 Then
                .Rows((lrCT + 1) & ":" & (signRow - 1)).Hidden = True
            End If
            For r = 1 To .HPageBreaks.Count Step 1
                If lrCT - 4 < .HPageBreaks(r).Location.Row And lrPrint >= .HPageBreaks(r).Location.Row Then
                    headRowHei = .Rows(.PageSetup.PrintTitleRows).Height
                    pageHei = 11.7 * 72 - .PageSetup.TopMargin - .PageSetup.BottomMargin + r + 2
                    tRowHei = (r * pageHei - r * headRowHei - .Range("A1:A" & _
                    (.Rows(.PageSetup.PrintTitleRows).Row - 1)).Height) / (lrCT - frCT - 4)
                    .Rows(frCT & ":" & lrCT).RowHeight = tRowHei
                    Exit For
                End If
            Next
            .PageSetup.PrintArea = "B1:G" & lrPrint
            ActiveWindow.View = xlNormalView
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

alibaba2209 · 13/7/15

doveandrose đã viết:

làm vầy thì khỏi cần biết dòng cuối trong bảng là 207 hay bao nhiêu , cứ nhắm mắt đưa chân thôi

Mã:

Sub pagsetup()
Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long
Application.ScreenUpdating = False
Set shNames = Worksheets("Sheet1").Range("B1:B" & Worksheets("Sheet1").Range("B50000").End(xlUp).Row)
For Each ws In Worksheets
    If TypeName(Application.Match(ws.Name, shNames, 0)) <> "Error" Then
        With ws
            ws.Activate
            lrPrint = .[B50000].End(xlUp).Row
            .Range("A1:A" & lrPrint).EntireRow.Hidden = False
            arr = .Range("B1:D" & lrPrint).Value
            For r = UBound(arr) To 1 Step -1
                If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
                If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
                    lrCT = r
                    Exit For
                End If
            Next
            frCT = .Rows(.PageSetup.PrintTitleRows).Row + .Rows(.PageSetup.PrintTitleRows).Rows.Count
            .Rows(frCT & ":" & lrPrint).RowHeight = 14
            If lrCT < signRow - 1 Then
                .Rows((lrCT + 1) & ":" & (signRow - 1)).Hidden = True
            End If
            .PageSetup.PrintArea = "B1:G" & (lrPrint + 200)
            ActiveWindow.View = xlPageBreakPreview
            For r = 1 To .HPageBreaks.Count Step 1
                If lrCT - 4 < .HPageBreaks(r).Location.Row And lrPrint >= .HPageBreaks(r).Location.Row Then
                    headRowHei = .Rows(.PageSetup.PrintTitleRows).Height
                    pageHei = 11.7 * 72 - .PageSetup.TopMargin - .PageSetup.BottomMargin + r + 2
                    tRowHei = (r * pageHei - r * headRowHei - .Range("A1:A" & _
                    (.Rows(.PageSetup.PrintTitleRows).Row - 1)).Height) / (lrCT - frCT - 4)
                    .Rows(frCT & ":" & lrCT ).RowHeight = tRowHei
                    Exit For
                End If
            Next
            .PageSetup.PrintArea = "B1:G" & lrPrint
            ActiveWindow.View = xlNormalView
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

bị lỗi ở dòng này bạn ơi!
Set shNames = Worksheets("Sheet1").Range("B1:B" & Worksheets("Sheet1").Range("B50000").End(xlUp).Row)

doveandrose · 13/7/15

alibaba2209 đã viết:
bị lỗi ở dòng này bạn ơi!
Set shNames = Worksheets("Sheet1").Range("B1:B" & Worksheets("Sheet1").Range("B50000").End(xlUp).Row)

ai biểu bạn cho tôi xem hình thì tôi cứ theo hình mà làm .
hình #31 có sheet tên là sheet1 . file thật của bạn không có thì bạn ráng chịu chứ

alibaba2209 · 13/7/15

doveandrose đã viết:
ai biểu bạn cho tôi xem hình thì tôi cứ theo hình mà làm .
hình #31 có sheet tên là sheet1 . file thật của bạn không có thì bạn ráng chịu chứ

hehe! được rùi.. bạn pro quá.. thanks nhiều

alibaba2209 · 13/7/15

Phiền bạn 1 chút nữa: ở code trước muốn chạy all sheet trong file phải sửa như nào nhỉ:
giúp mình nốt cái này đi

Sub hidedongpro()
Dim lr As Long, lp As Integer, headRowHei As Double, pageHei As Double, rowCount As Integer, tRowHei As Double
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = True
With ws
.Range([b13], [b198]).EntireRow.Hidden = False
lr = Application.Match(1000, .Range("b13:b198"))
.Rows("13:300").RowHeight = 14
If TypeName(lr) = "Error" Then Exit Sub
If Val(.Range("D" & (lr + 13))) <> 0 Then lr = lr + 1
If lr < 198 Then .Range("b" & (lr + 13), "b198").EntireRow.Hidden = True
.PageSetup.PrintArea = "B1:G300"
ActiveWindow.View = xlPageBreakPreview
If lr + 8 < .HPageBreaks(2).Location.Row And .HPageBreaks(2).Location.Row <= 207 Then lp = 2
If lr + 8 < .HPageBreaks(1).Location.Row And .HPageBreaks(1).Location.Row <= 207 Then lp = 1
If lp > 0 Then
headRowHei = .Range("A11:A12").Height
pageHei = 11.7 * 72 - .PageSetup.TopMargin - .PageSetup.BottomMargin
rowCount = lr - 5
tRowHei = (lp * pageHei - lp * headRowHei - .Range("A1:A10").Height) / rowCount
.Range("A13:A198").SpecialCells(xlCellTypeVisible).EntireRow.RowHeight = tRowHei
End If
.PageSetup.PrintArea = "B1:G207"
End With
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

alibaba2209 · 13/7/15

alibaba2209 đã viết:
ý 1: là muốn code chạy all sheet trong file cell, còn dòng lên tới 207 nghĩa là mình đã chép code sang file khác và tùy chỉnh vùng lựa chọn thôi
ý 2: là mình muốn code chạy cho 1 số sheet, có tên có dạng "1.Kxx" chẳng hạn có ảnh minh họa
nhầm chút nhé.. Tên các sheet muốn code chạy

à! bạn ơi để các tên khác thì chạy ngon, mình cho tên 11, 22 vào list thì nó ko chạy, đổi tên nó lại chạy ngay nghĩa là sao nhỉ

doveandrose · 13/7/15

alibaba2209 đã viết:
Phiền bạn 1 chút nữa: ở code trước muốn chạy all sheet trong file phải sửa như nào nhỉ:
sửa ở chỗ chữ mầu đỏ này phải ko nhỉ bạn, giúp mình nốt cái này đi

sửa lại cho giống bài #34 100% thì mới chạy được . lưu ý bài #34 mới được chỉnh sửa lại cho phù hợp (sửa lúc 4h30)

alibaba2209 đã viết:
à! bạn ơi để các tên khác thì chạy ngon, mình cho tên 11, 22 vào list thì nó ko chạy, đổi tên nó lại chạy ngay nghĩa là sao nhỉ

sheet nào đó có tên là 11 thì trong Sheet1 phải ghi lại tên của nó là '11

Cần giúp đỡ viết code VBA ẩn dòng trống ko có dữ liệu và co dòng vừa trong trang >> (2 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

hello

Thành viên thường trực

Thành viên thường trực

hello

Thành viên thường trực

hello

Thành viên thường trực

hello

Thành viên mới

Thành viên thường trực

hello

Thành viên thường trực

hello

Thành viên thường trực

hello

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

hello

Đếm ngược thời gian