Форум программистов  
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 13.11.2017, 21:24   #1
ZlodeiDen
Пользователь
 
Регистрация: 14.04.2011
Сообщений: 19
Репутация: 10
По умолчанию копирование Гиперссылки. vba

Уважаемые форумчане!
помогите решить задачку.
пользуюсь данной процедурой:

Код:

Option Explicit

Sub test()
    Dim rngTable As Range   'Main Table range
    Dim rngCol As Range     'Column which contains organizations names
    Dim rngList As Range    'Range where organizations list is copied
    Dim rngCrit As Range    'Cell which contains organization name for filtering
    Dim i As Long           'Counter
    
    'Set variables
    With Sheets("Data")
        On Error GoTo ErrHandler
        Set rngTable = .Range(Application.InputBox _
            (prompt:="Select a cell in the first data row:", Type:=8).EntireRow.Cells(1), Intersect( _
            .Cells.Find("*", .Cells(1), xlValues, xlWhole, xlByRows, xlPrevious).EntireRow, _
            .Cells.Find("*", .Cells(1), xlValues, xlWhole, xlByColumns, xlPrevious).EntireColumn))
        'Ask the user to choose the column with Organizations
        Set rngCol = Intersect(rngTable, Application.InputBox _
            (prompt:="Select a cell in the Organization column:", Type:=8).EntireColumn)
        On Error GoTo 0
    Application.ScreenUpdating = False
    End With
    Set rngList = Sheets("List").[A1]
    Set rngCrit = Sheets("Criteria").[A2]
    
    'Renew the organizations list (unique)
    rngList.CurrentRegion.ClearContents
    rngCol.AdvancedFilter xlFilterCopy, , rngList, True
    Set rngList = rngList.CurrentRegion
    
    'Clear the creteria cell
    rngCrit.ClearContents
    
    'Create new workbooks with the name of the organization
    For i = 2 To rngList.Count
        rngCrit.FormulaR1C1 = _
            "=" & rngCol(1).Address(False, False, xlR1C1, True) & "=""" & rngList(i) & """"
        With Workbooks.Add
            With .Sheets(1)
                rngTable.AdvancedFilter xlFilterCopy, rngCrit.Offset(-1).Resize(2), .[A1]
                rngTable.Parent.Rows("1:3").Copy
                .Rows("1:1").Insert Shift:=xlDown
                .UsedRange.EntireColumn.AutoFit
            End With
            Application.DisplayAlerts = False
            .SaveAs ThisWorkbook.Path & "\" & rngList(i) & ".xlsx"
            Application.DisplayAlerts = True
            .Close True
        End With
    Next i
ErrHandler:
Application.ScreenUpdating = True
End Sub

столкнулся с проблемой, данный код не умеет копировать в новую книгу гиперссылки((( копирует только текст описание для ссылки.
потратил день, а проблему не решил, оказалось не по зубам проблема. вся надежда на вас)))
выручайте! в каком направлении двигаться?
ZlodeiDen вне форума   Ответить с цитированием
Старый 14.11.2017, 17:16   #2
Казанский
Профессионал
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 1,859
Репутация: 682
По умолчанию

Необходим файл-пример, в т.ч. с гиперссылками.
__________________
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума   Ответить с цитированием
Старый 15.11.2017, 11:07   #3
ZlodeiDen
Пользователь
 
Регистрация: 14.04.2011
Сообщений: 19
Репутация: 10
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
Необходим файл-пример, в т.ч. с гиперссылками.
извиняюсь, забыл выложить пример.
В файле тест, примерная таблица с гиперссылками, её нужно разбить на 3 файла, с этим проблем нет. но почему-то теряются гиперссылки, остаётся только "текст описание" см. файлы Москва, СПб, Сочи.
Вложения
Тип файла: rar test.rar (36.4 Кб, 0 просмотров)
ZlodeiDen вне форума   Ответить с цитированием
Ответ



Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
VBA. Копирование по условию 0mega Microsoft Office Excel 2 01.11.2017 07:44
Копирование картинок в VBA Lugovaya Помощь студентам 0 25.05.2012 10:44
Копирование картинок и создание папок VBA STYDENT13 Microsoft Office Excel 5 24.05.2012 01:05
Копирование результатов фильтрации VBA mchip Microsoft Office Excel 12 05.04.2010 10:14




08:41.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

купить трафик


как улучшить посещаемость, а также решения по монетизации сайтов, видео и приложений

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru