Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Печать объединенной ячейки, При печати текст дублируется на вторую страницу
 
Есть объединенная ячейка. У нее при заполнении автоматически увеличивается размер в высоту, тем самым всегда виден весь набранный текст. Проблема: когда идет печать двух листов, на одном расположена эта объединенная ячейка, на другом другая информация (просто текст) то на печати вылезает следующая картина: текст из объединенной ячейки печатается на втором листе тоже. Помогите разобраться с проблемой. Сразу скажу код автоматического увеличения размера объединенной ячейки писал не я, не могу разобрать что там к чему.
Код
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
 
Изменено: mukhametov - 03.03.2017 08:39:42
Печать второго листа на обороте первого
 
Sanja, Юрий М, все получилось. Тема закрыта. Спасибо.
Печать второго листа на обороте первого
 
Юрий М, спасибо с этим разобрался. Теперь думаю как сделать чтобы второй скрытый лист "Список полимеров" печатался.
Печать второго листа на обороте первого
 
Прошу помощи в решении задачи. Принтер с дуплексной печатью. Книга с несколькими листами. Необходимо чтобы второй лист печатался на обороте первого, а не на отдельном листе. Форматирование страниц разное. А в идеале было бы когда второй лист еще и скрыт.
Код
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
Опрос по ячейкам и вывод на печать, Опрос по ячейкам и вывод на печать
 
Sanja, спасибо. Все работает.
Изменено: mukhametov - 02.03.2017 12:06:29
Опрос по ячейкам и вывод на печать, Опрос по ячейкам и вывод на печать
 
Печатаем лист, проверяем наличие заполнения ячеек. При условии что они заполнены идет печать, после данные в этих ячейках обнуляются.
Работает не совсем верно. При проверке ячейка 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
Код
=ЕСЛИ(ПОИСК("S1";D2)=7;"Морозов";ЕСЛИ(ПОИСК("S2";D2)=7;"Ганиев";ЕСЛИ(ПОИСК("S3";D2)=7;"Зимановских";"Квашнин")))

Подскажите что не так.  
Объединенная ячейка автоподбор высоты, Объединенная ячейка автоподбор высоты при наборе текста
 
Решение найдено Решение
Объединенная ячейка автоподбор высоты, Объединенная ячейка автоподбор высоты при наборе текста
 
Есть объединенная ячейка 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
Выполнение макроса, если значение в ячейке не равно нулю
 
Цитата
По первому вопросу почитайте про оператор If...Then...Else
помогло, спасибо.
Выполнение макроса, если значение в ячейке не равно нулю
 
Спасибо, работает.
Добавил сообщение, но оно работает при любых условиях, а надо чтобы только при условии что макрос не сработал. Подскажите как правильно сделать.
Код
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

И еще проблемка выскочила, сообщения на другой машине выходят не читаемыми символами. Что то с кодировкой. Как исправить?
Изменено: mukhametov - 01.02.2017 08:48:22
Выполнение макроса, если значение в ячейке не равно нулю
 
Есть макрос который назначен на кнопку. Но необходимо чтобы он выполнялся только когда значение в ячейке площадь В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
Прошу помочь с решением.
Изменено: mukhametov - 31.01.2017 17:48:49
Страницы: 1
Наверх