Есть объединенная ячейка. У нее при заполнении автоматически увеличивается размер в высоту, тем самым всегда виден весь набранный текст. Проблема: когда идет печать двух листов, на одном расположена эта объединенная ячейка, на другом другая информация (просто текст) то на печати вылезает следующая картина: текст из объединенной ячейки печатается на втором листе тоже. Помогите разобраться с проблемой. Сразу скажу код автоматического увеличения размера объединенной ячейки писал не я, не могу разобрать что там к чему.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "B14"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
End Sub
Прошу помощи в решении задачи. Принтер с дуплексной печатью. Книга с несколькими листами. Необходимо чтобы второй лист печатался на обороте первого, а не на отдельном листе. Форматирование страниц разное. А в идеале было бы когда второй лист еще и скрыт.
Код
Sub Add_Sell()
With Worksheets("Смена")
Set Rng = .Range("F1,D3,F5,F6,F11,D16")
If Intersect(Rng, .Cells.SpecialCells(xlCellTypeBlanks)) Is Nothing Then
Sheets(Array("Смена", "Список полимеров")).PrintOut Copies:=1, Collate:=True
Rng.ClearContents
Else
MsgBox "Необходимо заполнить всю информацию!"
End If
End With
End Sub
Печатаем лист, проверяем наличие заполнения ячеек. При условии что они заполнены идет печать, после данные в этих ячейках обнуляются. Работает не совсем верно. При проверке ячейка D3, если она заполнена сразу идет печать. Подскажите как исправить.
Код
Sub Add_Sell()
With Sheets("Смена")
If Not IsEmpty(.[F1]) And IsEmpty(.[D3,F5,F6,F11,D16]) = False Then
.PrintOut Copies:=1, Collate:=True
.[F1,D3,F5,F6,F11,B14:F14,D16].ClearContents
Else
MsgBox "Необходимо заполнить всю информацию!"
End If
End With
End Sub
Есть тестовое поле которое может содержать S1, S2, S3, S4 например вот такой текст: 31Jan_S2_58L_FAC_1000x1067 Замысле такой, найти сочетание "S1" и тогда в ячейку записываем Фамилию, и таких условий 4
Есть объединенная ячейка B13, это текстовое поле. При наборе теста весь он не влезает. Как сделать так чтобы после набора теста и нажатия клавиши Enter, т.е. перехода на другую ячейку происходил автоподбор высоты ячейки и весь текст становился видимым. Есть макрос который работает, но как его приладить к данному условию "при конце набора текста и переходе на другую ячейку" я не могу придумать. Макрос писал не я, моих знаний тут ноль. Прошу подсказать решение. Этот макрос работает только тогда, когда стоишь в ячейке в которой надо сделать автоподбор высоты и только на увеличение размера, а на уменьшение нет.
Код
ublic Sub AutoHeight()
Dim ws As Worksheet
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Set ws = ActiveSheet
With ws
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(ActiveCell.MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End With
End Sub
Спасибо, работает. Добавил сообщение, но оно работает при любых условиях, а надо чтобы только при условии что макрос не сработал. Подскажите как правильно сделать.
Код
Sub Add_Sell()
With Sheets("Форма ввода")
If .[B15].Value > 0 And IsEmpty(.[B7]) = False Then
.[A22:E22].Copy
n = Sheets("Расход").[A100000].End(xlUp).Row
Sheets("Расход").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues
.[B7,B9,B11].ClearContents
ActiveWorkbook.Save
End If
MsgBox "Внесите всю информацию!"
End With
End Sub
И еще проблемка выскочила, сообщения на другой машине выходят не читаемыми символами. Что то с кодировкой. Как исправить?
Есть макрос который назначен на кнопку. Но необходимо чтобы он выполнялся только когда значение в ячейке площадь В15 было больше нуля и была заполнена ячейка В7 (название полимера). Тем самым хотелось бы избавиться от пустых записей.
Код
Sub Add_Sell()
Worksheets("Форма ввода").Range("A22:E22").Copy
n = Worksheets("Расход").Range("A100000").End(xlUp).Row
Worksheets("Расход").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues
Worksheets("Форма ввода").Range("B7,B9,B11").ClearContents
ActiveWorkbook.Save
End Sub