Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Экспорт значения НЕ текстовой фигуры в ячейку, Возможен ли экспорт значения НЕ текстовой фигуры в ячейку?
 
#1
09.04.2024 16:31:54
Всем добрый день!
Возможен ли экспорт значения НЕ текстовой фигуры в ячейку? - во вложении файл с макросом экспорта значения ячейки в ячейку, расположенную на той же строке, что и фигура. В общем и целом все хорошо, но вот работать с тестовой фигурой очень не удобно, хотелось бы заменить текстовую фигуру на простой "прямоугольник"
Сам вопрос:
- Как откорректировать код, чтоб экспортировать значение НЕ текстовой фигуры в ячейку?
Вопрос для альтернативного решение задачи (если из простой фигуры экспорт не возможен):
- Как откорректировать код, чтоб экспортировать значение текстовой фигуры которая не выделена, а просто находится напротив кнопки запуска макроса?

Буду благодарен за ваши мысли и помощь в данном вопросе!
 
 
 
#2
09.04.2024 16:42:48
Код
Sub Экспорт_Из_Выбран_Текст_Фигуры()
    Dim Sh
    Dim текстФигуры As String
    On Error GoTo Ext_Sub
    ' Проверяем заголовок активной фигуры на наличие "Заявка" в начале текста
    If Selection.Caption Like "Заявка" & "*" Then
        Set Sh = Selection
'        ' Проверяем, является ли фигура текстовой
'        If Sh.Type = msoTextBox Then
'            текстФигуры = Sh.TextFrame.Characters.Text
'        End If
        текстФигуры = Selection.Caption
        ' Адрес ячейки, в которую поместится текст
        ' В ячейки записываются последние три символа в качестве целого числа
        Range("I" & Sh.TopLeftCell.Row).Value = CDbl(Replace(Right(текстФигуры, 3), "_", "", , , vbTextCompare))
    End If
Ext_Sub:
End Sub
 
 
 
#3
09.04.2024 17:29:32
МатросНаЗебре, всё отлично работает для обычной, не текстовой фигуры! Вы мой кумир, огромная Вам благодарность!!!


Почему то мне кажется следующей задачей для меня будет - а можно ли после перетаскивания мышкой нескольких прямоугольников одной кнопкой запустить экспорт данных из них в ячейки на против каждого прямоугольника, ну и конечно же я обращусь с таким вопросом к Вам. Как думаете, возможно ли такое?
 
 
 
#4
10.04.2024 10:39:02
Всем Добрый День!
Всё же встал живой вопрос по написанию кода:
- Код экспорта значения нескольких фигур в ячейки, расположенные в тех же строках что и фигуры-доноры.
То, что должно получиться - схематично в приложенном файле, буду признателен за помощь!
 
 
 
#5
10.04.2024 13:26:56
Код
Sub Экспорт_Из_Всех_Фигур()
    On Error Resume Next
    Dim sh As Shape
    Dim текстФигуры As String
    For Each sh In ActiveSheet.Shapes
        текстФигуры = sh.DrawingObject.Caption
        If текстФигуры Like "Заявка" & "*" Then
            Application.Goto Range("I" & sh.TopLeftCell.Row)
            Range("I" & sh.TopLeftCell.Row).Value = CDbl(Replace(Right(текстФигуры, 3), "_", "", , , vbTextCompare))
        End If
        текстФигуры = ""
    Next
    
    On Error GoTo 0
End Sub
 
 
 
#6
12.04.2024 07:46:11
МатросНаЗебре, Доброго дня! - приношу извинения за не оперативный ответ - занимался по другому направлению.
Код успешно отработал, снял массу вопросов и большую головную боль!
Огромное спасибо!!!!!!!
 
 
 
Страницы: 1
Наверх