Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit Sub
End If
End Sub
Cám ơn bạn phulien1902.
Bạn phulien1902 có thể chèn vào đoạn code của mình được không vậy.
Mình chả rành VBA cho lắm. Mình xin đưa nguyên code của nút In:
Mã:
Private Sub cmd_in6_Click()
Dim Arr, rng As Range, r As Long, c As Long
r = Worksheets("Bao cao").Range("A65536").End(xlUp).Row
With Worksheets("Bao cao").Range("A5:G" & r)
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
Worksheets("Bao cao").Range("D2").Value = cb_thang6.Value
Arr = ListBox7.List
ReDim Preserve Arr(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To ListBox7.ColumnCount - 1)
For r = LBound(Arr) To UBound(Arr)
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2)
Arr(r, c) = CDbl(Arr(r, c))
Next
Next
With Worksheets("Bao cao").Range("A5").Resize(UBound(Arr) - LBound(Arr) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1)
.Value = Arr
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'Worksheets("Bao cao").Range("A2").Resize(UBound(Arr) - LBound(Arr) + 4, UBound(Arr, 2) - LBound(Arr, 2) + 1).Columns.AutoFit
' in bao cao
With Worksheets("Bao cao").PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
End Sub
Mong bạn chèn vào code In dùm mình, khi nhấn nút In thì hiện MsgBox chọn khổ giấy, nếu chọn khổ giấy ngang thì in ngang, nếu chọn khổ giấy đứng thì in đứng.
Cám ơn bạn.
Code không phải do mình viết, mà là của một "Tiền Bối" viết dùm. MÌnh chả biết tí gì về code. Mình hiểu nom na là lấy dữ liệu từ ListBox7 đập vào Sheet"Bao cao" rồi mới in đó bạn.
' in bao cao
With Worksheets("Bao cao").PageSetup
.Orientation = xlLandscape
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
nhưng bị lỗi "438" "Object doesn't support this property or method"
Mong các AC giúp đỡ.
Cám ơn bạn phulien1902.
Bạn phulien1902 có thể chèn vào đoạn code của mình được không vậy.
Mình chả rành VBA cho lắm. Mình xin đưa nguyên code của nút In:
Mã:
Private Sub cmd_in6_Click()
Dim Arr, rng As Range, r As Long, c As Long
r = Worksheets("Bao cao").Range("A65536").End(xlUp).Row
With Worksheets("Bao cao").Range("A5:G" & r)
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
Worksheets("Bao cao").Range("D2").Value = cb_thang6.Value
Arr = ListBox7.List
ReDim Preserve Arr(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To ListBox7.ColumnCount - 1)
For r = LBound(Arr) To UBound(Arr)
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2)
Arr(r, c) = CDbl(Arr(r, c))
Next
Next
With Worksheets("Bao cao").Range("A5").Resize(UBound(Arr) - LBound(Arr) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1)
.Value = Arr
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'Worksheets("Bao cao").Range("A2").Resize(UBound(Arr) - LBound(Arr) + 4, UBound(Arr, 2) - LBound(Arr, 2) + 1).Columns.AutoFit
' in bao cao
With Worksheets("Bao cao").PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
End Sub
Mong bạn chèn vào code In dùm mình, khi nhấn nút In thì hiện MsgBox chọn khổ giấy, nếu chọn khổ giấy ngang thì in ngang, nếu chọn khổ giấy đứng thì in đứng.
Cám ơn bạn.
Gửi luôn form có code đi bạn, coi thì thấy nó chỉ cho bạn xem trc rồi muốn in hay k. Còn nội dung form có gì thì sao.
Ví dụ
Mã:
Private Sub cmd_in6_Click()
Inan sheets("bao cao")
End Sub
Vậy thôi thì sao. Đố bạn biết code xử lý thế nào.
Với lại cái này tôi thấy chắc chỉ cần ghi macro thôi là ra.
Bạn thông cảm, đang sốt nói chuyện hơi lung tung.
Dạ trong Form chỉ có : 1 combobox (cb_thang6) 1 commandbutton (cmd_in6) vào 1 listbox (listBox7)
Khi chọn giá trị trong cb_thang6 thì sẽ gán dữ lieu vào Listbox7 (có 7 cột) và nhấn nút In (cmd_in6) thì đập dữ lieu của ListBox7 váo Sheet"Bao cao" từ A5:G và Border, còn Sheet"Bao cao"!(D2) thì bằng giá trị của cb_thang6.
Nhưng khi in thì mặc định in là giấy dọc, mà có tới 7 cột nên in không vừa,nên em muốn code chuyển từ giấy dọc qua giấy ngang (chứ không vào Pagesetup của excel đê chuyển)
Mong mọi người xem giúp.
Dạ trong Form chỉ có : 1 combobox (cb_thang6) 1 commandbutton (cmd_in6) vào 1 listbox (listBox7)
Khi chọn giá trị trong cb_thang6 thì sẽ gán dữ lieu vào Listbox7 (có 7 cột) và nhấn nút In (cmd_in6) thì đập dữ lieu của ListBox7 váo Sheet"Bao cao" từ A5:G và Border, còn Sheet"Bao cao"!(D2) thì bằng giá trị của cb_thang6.
Nhưng khi in thì mặc định in là giấy dọc, mà có tới 7 cột nên in không vừa,nên em muốn code chuyển từ giấy dọc qua giấy ngang (chứ không vào Pagesetup của excel đê chuyển)
Mong mọi người xem giúp.
Private Sub cmd_in6_Click()
Dim Arr, rng As Range, r As Long, c As Long
r = Worksheets("Bao cao").Range("A65536").End(xlUp).Row
With Worksheets("Bao cao").Range("A5:G" & r)
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
Worksheets("Bao cao").Range("D2").Value = cb_thang6.Value
Arr = ListBox7.List
ReDim Preserve Arr(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To ListBox7.ColumnCount - 1)
For r = LBound(Arr) To UBound(Arr)
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2)
Arr(r, c) = CDbl(Arr(r, c))
Next
Next
With Worksheets("Bao cao").Range("A5").Resize(UBound(Arr) - LBound(Arr) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1)
.Value = Arr
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'Worksheets("Bao cao").Range("A2").Resize(UBound(Arr) - LBound(Arr) + 4, UBound(Arr, 2) - LBound(Arr, 2) + 1).Columns.AutoFit
' in bao cao
With Worksheets("Bao cao").PageSetup
'.Orientation = xlLandscape ' giay ngang
'.Orientation = xlPortrait'giay doc
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Select_abc
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
End Sub
Private Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit Sub
End If
End Sub
Em có them vào code:
' in bao cao
With Worksheets("Bao cao").PageSetup
.Orientation = xlLandscape
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
nhưng bị lỗi "438" "Object doesn't support this property or method"
Mong các AC giúp đỡ.
rồi bạn đã thử copy toàn bộ code ở #13 thay thế cho code của nút in trong form của bạn chưa.
nói code của phulien1902 có nghĩa là tôi lấy code của bác ấy ghép vô cho bạn, chứ có phải là code cũ đâu.
bạn đã thử nhấn F8 trong lúc chạy code chưa. hay lắm đó. một cách học code, test lỗi. thử đi, tôi học theo cách ghi macro với F8 không à.
nếu bạn muốn có kiến thức về vba thì tập cách ghi macro rồi thao tác trên bảng tính, xong mở cửa sổ soạn thảo code rồi nhấn F8 xem công việc nó làm thế nào, từ đó rút ra kinh nghiệm, rút gọn code sau khi ghi macro (code thừa nhiều) rồi lúc đó sẽ biết code đó làm công việc đó. sau đó tùy biến từng trường hợp thôi.
Anh chỉ em nhấn F8 với, chứ em vào VBE code em có tới 4 Sub thì em làm sao, trong code của bạn Phulien1902 phải bỏ "ActiveWindow.SelectedSheets,PrintPreview" vì khi đó Form nó "trơ" ra luô
Thì bỏ dòng đó đi thôi
Chỗ nào ban thấy có chữ Sub
..... gì đó, nhấn chuột vào đó nhấn f9 cho dòng đó thành màu đỏ
Làm tương tự với 4 cái kia
Xong bật form lên, thao tác như bình thường.
Khi bạn nhấn vào nút lệnh thì sẽ bật cửa sổ VBA lên.
Thu cửa sổ nhỏ lại để có thể nhìn trên trang tính.
Đặt chuột trở lại cửa sổ VBA. Nhấn F8 vừa nhấn vừa xem trên trang tính có gì thay đổi. Tức là dòng đó thực hiện việc đó.
Ghi chú lại để nhớ.
Để ghi chú được thì bạn chọn ở điểm cuối cùng của dòng code nhấn dấu ' rồi ghi chú. Lưu ý. Nếu điểm cuối cùng bạn thấy có ký tự _ thì không ghi chú ngay dòng đó được. Ghi chú chỗ khác
Làm sao mà dòng code đó không bị chuyển thành màu đỏ là được.
Như những code bên trên khi bạn dán vào cửa sổ VBA thì có những đoạn màu xanh lá. Đó là ghi chú.
Thấy bạn hỏi rồi trả lời trên diễn đàn dữ lắm mà mấy cái cơ bản vậy còn chưa biết thì thua. Nên mua 1 chương trình nào đó phục vụ được cho công việc mà dùng. Chứ bạn hỏi code trên này hoài mà không biết ý nghĩa code người khác viết thì thua.
Anh chỉ em nhấn F8 với, chứ em vào VBE code em có tới 4 Sub thì em làm sao, trong code của bạn Phulien1902 phải bỏ "ActiveWindow.SelectedSheets,PrintPreview" vì khi đó Form nó "trơ" ra luô
Thì bỏ dòng đó đi thôi
Chỗ nào ban thấy có chữ Sub
..... gì đó, nhấn chuột vào đó nhấn f9 cho dòng đó thành màu đỏ
Làm tương tự với 4 cái kia
Xong bật form lên, thao tác như bình thường.
Khi bạn nhấn vào nút lệnh thì sẽ bật cửa sổ VBA lên.
Thu cửa sổ nhỏ lại để có thể nhìn trên trang tính.
Đặt chuột trở lại cửa sổ VBA. Nhấn F8 vừa nhấn vừa xem trên trang tính có gì thay đổi. Tức là dòng đó thực hiện việc đó.
Ghi chú lại để nhớ.
Để ghi chú được thì bạn chọn ở điểm cuối cùng của dòng code nhấn dấu ' rồi ghi chú. Lưu ý. Nếu điểm cuối cùng bạn thấy có ký tự _ thì không ghi chú ngay dòng đó được. Ghi chú chỗ khác
Làm sao mà dòng code đó không bị chuyển thành màu đỏ là được.
Như những code bên trên khi bạn dán vào cửa sổ VBA thì có những đoạn màu xanh lá. Đó là ghi chú.
Thấy bạn hỏi rồi trả lời trên diễn đàn dữ lắm mà mấy cái cơ bản vậy còn chưa biết thì thua. Nên mua 1 chương trình nào đó phục vụ được cho công việc mà dùng. Chứ bạn hỏi code trên này hoài mà không biết ý nghĩa code người khác viết thì thua.
- Nếu bạn ấy không đưa File lên, thì chúng ta phỏng đoán cũng không trúng được, vậy những dòng code chúng ta code, sẽ giống nhu áp dụng cho mô hình thôi,
Tôi không hiểu Code của bạn, nên không thể giúp gì được bạn rồi
...Gửi luôn form có code đi bạn, coi thì thấy nó chỉ cho bạn xem trc rồi muốn in hay k. Còn nội dung form có gì thì sao
...
- Nếu bạn ấy không đưa File lên, thì chúng ta phỏng đoán cũng không trúng được
Xin các AC giúp em chổ Sub Select_abc(), khi chọn "CanCel" thì thoát Sub Select_abc () đồng thời cũng thoát luôn sub cmd_in6_Click(), em thử thế này mà không được:
Mã:
Private Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit_cmd_in6_Click: <-------them cho nay
Exit Sub
End If
End Sub
nếu vậy thì code chỉ vầy thôi là cho bạn ấy sự lựa chọn trang dọc hay ngang rồi thầy. có gì đâu mà không áp dụng được.
hôm nay tạm khỏe lại rồi. bạn rùa con xem ok chưa he
Mã:
Private Sub cmd_in6_Click()
Dim Arr, rng As Range, r As Long, c As Long
Dim a As Byte
r = Worksheets("Bao cao").Range("A65536").End(xlUp).Row 'chon dong cuoi cung cua cot A
With Worksheets("Bao cao").Range("A5:G" & r) 'lam viec voi vung "A5:G" & r
.ClearContents 'xoa du lieu cu
'xoa vien thi chi 1 dong nhu vay duoc roi
.Borders.LineStyle = xlNone 'xoa ke vien
End With
Worksheets("Bao cao").Range("D2").Value = cb_thang6.Value 'dien gia tri cua cb_thanng 6 xuong o D2 Sheet BaoCao
Arr = ListBox7.List 'gan mang bang gia tri cua listbox7
ReDim Preserve Arr(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To ListBox7.ColumnCount - 1) 'khai bao lai mang giu nguyen gia tri cu
For r = LBound(Arr) To UBound(Arr) ' vong lap tu dau den cuoi bang
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2) 'vong lap tu cot dau den cot cuoi cua bang
Arr(r, c) = CDbl(Arr(r, c)) 'chuyen gia tri cua mang sang kieu double
Next c
Next r
With Worksheets("Bao cao").Range("A5").Resize(UBound(Arr) - LBound(Arr) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) ' lam viec voi vung moi
.Value = Arr ' dien gia tri xuong
'ke bang thi chi 1 dong nhu vay duoc roi
.Borders.LineStyle = xlContinuous 'ke bang
End With
'Worksheets("Bao cao").Range("A2").Resize(UBound(Arr) - LBound(Arr) + 4, UBound(Arr, 2) - LBound(Arr, 2) + 1).Columns.AutoFit'chinh lai chieu cao dong
' in bao cao
With Worksheets("Bao cao").PageSetup 'dinh dang trang tinh
a = MsgBox("Chon trang ngang hay doc" & ChrW(10) & "YES: Trang doc" & "NO: Trang ngang", vbYesNo, "Thông báo") 'lua chon trang ngang hoac doc
If a = vbYes Then
.Orientation = xlPortrait ' doc
ElseIf a = vbNo Then
.Orientation = xlLandscape ' ngang
End If
'gan tieu de ngang va doc
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut 'xuat lenh in tai vung A1:G xxxx
End Sub
Xin các AC giúp em chổ Sub Select_abc(), khi chọn "CanCel" thì thoát Sub Select_abc () đồng thời cũng thoát luôn sub cmd_in6_Click(), em thử thế này mà không được:
Mã:
Private Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit_cmd_in6_Click: <-------them cho nay
Exit Sub
End If
End Sub
Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a <> vbYes And a <> vbNo Then
Exit Sub
ElseIf a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit Sub
End If
End Sub
Nếu đưa điều kiện đầu tiên để xử lý khi chọn Cancel thì được không,
Sub Select_abc()
Dim a As String
a = MsgBox("Chon trang ngang hay doc", vbYesNoCancel, "Thong bao")
If a <> vbYes And a <> vbNo Then
Exit Sub
ElseIf a = vbYes Then
ActiveSheet.PageSetup.Orientation = xlPortrait ' doc
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
ElseIf a = vbNo Then
ActiveSheet.PageSetup.Orientation = xlLandscape ' ngang
'ActiveWindow.SelectedSheets.PrintOut
ActiveWindow.SelectedSheets.PrintPreview
Exit Sub
End If
End Sub
Nếu đưa điều kiện đầu tiên để xử lý khi chọn Cancel thì được không,
đâu cần viết dài dòng thế bạn
chỉ cần vầy được rồi
Mã:
if a = 6 then' YES
elseif a = 7 then' NO
else'truong hop con lai CANCEL = 2
end if
nếu bạn ấy muốn thêm cancel nữa thì code sẽ vầy. không đọc bài nên thiếu yêu cầu
Mã:
Private Sub cmd_in6_Click()
Dim Arr, rng As Range, r As Long, c As Long
Dim a As Byte
r = Worksheets("Bao cao").Range("A65536").End(xlUp).Row 'chon dong cuoi cung cua cot A
With Worksheets("Bao cao").Range("A5:G" & r) 'lam viec voi vung "A5:G" & r
.ClearContents 'xoa du lieu cu
'xoa vien thi chi 1 dong nhu vay duoc roi
.Borders.LineStyle = xlNone 'xoa ke vien
End With
Worksheets("Bao cao").Range("D2").Value = cb_thang6.Value 'dien gia tri cua cb_thanng 6 xuong o D2 Sheet BaoCao
Arr = ListBox7.List 'gan mang bang gia tri cua listbox7
ReDim Preserve Arr(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To ListBox7.ColumnCount - 1) 'khai bao lai mang giu nguyen gia tri cu
For r = LBound(Arr) To UBound(Arr) ' vong lap tu dau den cuoi bang
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2) 'vong lap tu cot dau den cot cuoi cua bang
Arr(r, c) = CDbl(Arr(r, c)) 'chuyen gia tri cua mang sang kieu double
Next c
Next r
With Worksheets("Bao cao").Range("A5").Resize(UBound(Arr) - LBound(Arr) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) ' lam viec voi vung moi
.Value = Arr ' dien gia tri xuong
'ke bang thi chi 1 dong nhu vay duoc roi
.Borders.LineStyle = xlContinuous 'ke bang
End With
'Worksheets("Bao cao").Range("A2").Resize(UBound(Arr) - LBound(Arr) + 4, UBound(Arr, 2) - LBound(Arr, 2) + 1).Columns.AutoFit'chinh lai chieu cao dong
' in bao cao
With Worksheets("Bao cao").PageSetup 'dinh dang trang tinh
a = MsgBox("Chon trang ngang hay doc" & ChrW(10) & "YES: Trang doc" & "NO: Trang ngang" & ChrW(10) & "CANCEL: Bo Qua", 3, "Thông báo") 'lua chon trang ngang, doc hoac bo qua
If a = 6 Then
.Orientation = xlPortrait ' doc
ElseIf a = 7 Then
.Orientation = xlLandscape ' ngang
Else
Exit Sub
End If
'gan tieu de ngang va doc
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut 'xuat lenh in tai vung A1:G xxxx
End Sub
Em có them vào code:
' in bao cao
With Worksheets("Bao cao").PageSetup
.Orientation = xlLandscape
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$G"
End With
Worksheets("Bao cao").Range("A1:G" & ListBox7.ListCount + 4).PrintOut
nhưng bị lỗi "438" "Object doesn't support this property or method"
Mong các AC giúp đỡ.
Anh langtuchungtinh360 có thể giải thích cho em chổ số 3 trong code :
Mã:
For r = LBound(Arr) To UBound(Arr) ' vong lap tu dau den cuoi bang
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2) 'vong lap tu cot dau den cot cuoi cua bang
Arr(r, c) = CDbl(Arr(r, c)) 'chuyen gia tri cua mang sang kieu double
Next c
Next r
theo em nghỉ là có phải từ cột số 4 của bang định dạng là kiểu số
Anh langtuchungtinh360 có thể giải thích cho em chổ số 3 trong code :
Mã:
For r = LBound(Arr) To UBound(Arr) ' vong lap tu dau den cuoi bang
For c = LBound(Arr, 2) + 3 To UBound(Arr, 2) 'vong lap tu cot dau den cot cuoi cua bang
Arr(r, c) = CDbl(Arr(r, c)) 'chuyen gia tri cua mang sang kieu double
Next c
Next r
theo em nghỉ là có phải từ cột số 4 của bang định dạng là kiểu số
vâng, chỉ là em đoán mò thôi mà. hên thì trúng không thì thôi :v. với lại em chỉ xem cú pháp chứ chưa để ý những cái khác.
em cũng mới vừa nhận được file nên mới biết. chứ em có để ý là code làm cho công việc gì đâu mà biết nó như thế nào để xử lý.
cũng chưa đúng ý em, anh langtuchungtinh360 ơi !
Code của anh là in chỉ 1 trang duy nhất (lúc đó chữ và số nó sẽ nhỏ lại).
Ý của em là in đầy đủ dữ lieu từ cột STT đến cột ghi chú.
Ví dụ như chọn "Thun 2.5Cm Đen TS14" có STT tới 43 thì in trang ngang , ra là 3 trang.
Mong anh xem giúp.
cũng chưa đúng ý em, anh langtuchungtinh360 ơi !
Code của anh là in chỉ 1 trang duy nhất (lúc đó chữ và số nó sẽ nhỏ lại).
Ý của em là in đầy đủ dữ lieu từ cột STT đến cột ghi chú.
Ví dụ như chọn "Thun 2.5Cm Đen TS14" có STT tới 43 thì in trang ngang , ra là 3 trang.
Mong anh xem giúp.
bạn có chép code mới thay thế code cũ chưa.
code mới đó tôi chạy ra vầy nè
còn bạn chạy không được thì tôi thua. vừa đủ số cột bạn yêu cầu nhé.
còn lý do tại sao chữ nhỏ lại thì giải thích bạn thế này
bạn làm 1 file sau khi xuất y như vậy
BƯỚC 1. chỉnh sang chế độ như này
bạn làm như thế mà thấy khác của tôi đúng không (của tôi 6 trang, của bạn 9 trang)
BƯỚC 2: vào pageSetup
tôi đã bỏ chỗ này đi
tôi không biết bạn cài đặt thêm cái đó làm gì trong khi không cần thiết.
làm như vậy xong đóng đi
rồi làm như vầy nữa
BƯỚC 3:
rồi bạn xem kết quả đi
nó sẽ như vậy
đó là kết quả làm thủ công.
tất cả đều ghi macro lại được
và tôi đã làm sẵn trong code gửi cho bạn rồi
bạn chỉ cần làm bước 2 bỏ cột tiêu đề đi.
là thỏa lòng mong ước của bạn nhé
đây đều là kiến thức cơ bản trong excel của. trên diễn đàn cũng có hướng dẫn
bạn vui lòng tìm hiểu trước nhé.
xin lỗi nếu nói như thế làm bạn buồn. tôi làm dân xây dựng nên không có khiếu ăn nói, lời thật mất lòng, mà thật quá thì mất luôn bạn.
còn bạn muốn nhấn F8 để xem từng bước thì làm như vầy
làm y vầy rồi bạn làm các bước bạn muốn rồi nhấn IN
sẽ hiện ra vầy
rồi nhấn F8 xem mà tận hưởng đi
code cũ ở #32
phục bạn luôn
bạn là thành viên thứ 2 mà tôi nghĩ khoái VBA mà không biết VBA mà tôi biết trên diễn đàn này ấy
thắc mắc gì thì lấy điện thoại ra quét QRCODE liên lạc vs tôi sẽ hướng dẫn những gì tôi biết cho, còn người kia tôi không khoái nên chả giúp.
thế nhé, giờ về ngủ đây.
- Một Là dạo này anh ấy có tý tình yêu. Vui tính, thoải mái , yêu đời
- Hai là anh ấy thích Rùa Do vậy ốm cũng gắng giúp bạn ...
Còn người kia không gặp 2 trường hợp trên.
@langtuchungtinh360
(Ngoài lề), cách để bỏ cái trang Start mặc định ở Foxit Reader:
Menu File, Preferences, Gerneral, Application Startup: Bỏ check mục "Show Start page" (tiện thể bỏ check "Show Advertisement"), Click OK.
Chào Anh langtuchungtinh360!
Em ngồi quậy cả buổi thì mới được, bằng cách làm thủ công như Anh hướng dẫn rồi mới cài code.
Em cứ tưởng code nó làm hết.
Chào Anh langtuchungtinh360!
Em ngồi quậy cả buổi thì mới được, bằng cách làm thủ công như Anh hướng dẫn rồi mới cài code.
Em cứ tưởng code nó làm hết.
code không làm hết đâu bạn, code chỉ làm giùm bạn khi dữ liệu bạn cài đặt chuẩn rồi.
khi dữ liệu bạn chưa cài đặt chuẩn sao nó làm đúng được, cái máy mà đâu có thông minh đến nỗi nó biết chỗ đó sai sửa lại cho bạn.
bạn chỉ cần làm chuẩn 1 lần rồi mấy lần sau code nó tự làm cho bạn
lỗi bạn mắc phải khi in ra không phải là 3 trang là do bạn có cài đặt in cột tiêu đề, trong khi cái này không cần thiết (đã có nói ở trên rồi) bạn không xem kỹ nên làm không ra.
tại sao 100%
lúc bạn để automatic, 100% thì bảng tính của bạn sẽ có 6 trang
còn khi bạn chỉnh lại Width = 1 giống như bạn để chuột vào lề bên phải kéo qua hết phần bảng tính, thì khi đó để hiển thị đủ thông tin trong 1 khổ giấy thì bắt buộc nó sẽ zoom nhỏ lại. chữ sẽ nhỏ lại
ở đây do chỉ có vài cột bé bé nên chỉ zoom lại 96% như bạn thấy.
tôi chả biết đường mà giải thích đâu, nói hồi hồi lại lạc đề, bác nào giỏi biện hộ vô giải thích giùm em nó cái.
Cám ơn anh langtuchungtinh360!
Anh giúp em dịnh dạng cho dữ lieu khi nạp từ listbox7 vào cột C và E có định dạng là Date, cột E,G,H là "#,##0.00" để khi in nó cũng như vậy.
Vì có lúc in em cột C và E khúc trên là Date khúc dưới là Số, và cột E, G , H khúc trên là "#,##0.00" khúc dưới là "####"
Mong anh giúp.
