Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Как поменять картинку на VBA Excel
Отметить все сообщения как прочитанные   [ Помощь ]
» Добро пожаловать на форум "Информационные технологии" «

Переход к теме
<< Назад Вперед >>
Одна страница
Модераторы: paradise, KMA
  

dsapa


Новичок

Здравствуйте!
Я создал такой макрос типа заставки – увеличение логотипа при открытии файла (логотип представляет собой эмблему из разукрашенных клеток):

Sheets("Анимация").Select
Range("A1").Select
Dim Data0 As Range
Set Data0 = Cells(1, 1)
Dim Data2 As Range
Set Data2 = Cells(2631, 1)
'Очистка поля
Data2.Resize(288, 256).Copy Destination:=Data0.Resize(288, 256)
'начальная установка масштаба
ActiveWindow.Zoom = 10
Data2.Resize(288, 256).Copy Destination:=Data0.Resize(288, 256)
'Нахождение координат и вставка базового логотипа
Data0.Cells(837, 193).Resize(33, 52).Copy Destination:= _
Cells(1, 1).Resize(33, 52)
Sleep 500
'выбор начальной ячейки
Cells(1, 1).Select
'увеличение логотипа
For i = 10 To 400 Step 1
ActiveWindow.Zoom = i
Next i
ActiveWindow.Zoom = 400
Cells(873, 193).Resize(33, 52).Copy Destination:= _
Cells(1, 1).Resize(33, 52)
Sleep 2000
'Очистка поля
Data2.Resize(288, 256).Copy Destination:=Data0.Resize(288, 256)
ActiveWindow.Zoom = 10
Sleep 10
Worksheets("Отчет").Select
Range("A1").Select

Вопрос: как бы сделать так, чтобы этот логотип постепенно заменялся бы на другой рисунок (он хранится рядом с логотипом, на том же листе). Постепенно – это значит по одной клеточке в случайном порядке, как иногда меняют кадры в фильмах.
То есть все клеточки логотипа по очереди заменяются на клеточки другого рисунка, но не построчно, а в случайном порядке (примерно так же, как на аватаре АДМИНА)
Спасибо.


Всего сообщений: 2 | Присоединился: май 2008 | Отправлено: 23 мая 2008 9:29 | IP
dsapa


Новичок

А очень просто:
Sub Start()

   Dim i As Integer, j As Integer, a As Long, x As New Collection, y As Range
   With Sheets(2)
           .Range(.Cells(1, 1), .Cells(100, 100)).ClearContents
       ThisWorkbook.Sheets(2).Range("A1:CV100").ClearContents
       k = 0
        For i = 1 To 100
           For j = 1 To 100
               If Sheets(2).Cells(i, j).Interior.ColorIndex <> Sheets(1).Cells(i, j).Interior.ColorIndex Then
                   k = k + 1
                   Sheets(2).Cells(i, j).Value = k
             '  l.Add k, CStr(k)
               End If
           Next
       Next
       For i = 1 To 100
           For j = 1 To 100
           If Sheets(2).Cells(i, j).Value > 0 Then
Metka:          a = Int(Rnd() * k + 1)
               On Error Resume Next
               x.Add a, CStr(a)
               If Err <> 0 Then
                   On Error GoTo 0
                   GoTo Metka
               End If
               .Cells(i, j) = a
               End If
           Next
       Next
       Set x = Nothing
   For a = 1 To k
       Set y = .Range(.Cells(1, 1), .Cells(100, 100)).Find(What:=a, LookAt:=xlWhole)
       If Not y Is Nothing Then Sheets(1).Cells(y.Row, y.Column).Interior.ColorIndex = y.Interior.ColorIndex
   Next
   End With

End Sub

Всего сообщений: 2 | Присоединился: май 2008 | Отправлено: 2 июня 2008 17:23 | IP
marnich


Новичок

Включить индивидуальный счётчик доверия к убивающим во имя лучшей жизни. И исполнить последнюю волю невинно лишаемых этой жизни.

---------------------------------------------------------------------------------

Чтобы любой человек мог с помощью этого послания оформить свой личный оригинальный вклад в мировое культурное наследие, в текст введены двумя именами собственными обозначения ангелов для исполнения  роли  посредников между причастными к убийствам взрослыми и убитыми детьми – Хавзан и Тотаси.

С помощью этой пары слов каждый,  кто в этом нуждается,  может зашифровать  нужные ему сведения, чтобы использовать их впоследствии для подтверждения обоснованности своих претензий на признание конкретных  заслуг, включая анонимную деятельность в сети Интернет. В других местах исходного текста использование тайнописи не предусмотрено и всё написанное следует воспринимать буквально.

С сегодняшнего дня весь оставшийся у меня запас доверия  к еврейской нации я принимаю за 100% против таких же 100% сохранившегося остатка доверия к участникам  палестинского вооружённого сопротивления.  А начиная с 9 февраля 2009 года из обоих сумм начинаю  вычитать по 1% за каждый долетевший до израильской территории снаряд и за каждого убитого израильтянами палестинца.  Данные для изменения показаний счётчика берём из официальных сообщений по таким каналам, как  Евроньюс.

Каждый поступающий аналогично должен хорошо осознавать, что реакция любой из участвующих в ближневосточном конфликте сторон на очередной включённый счётчик определяется скоростью возрастания  количества людей, которые открыто поддерживают  инициативу по включению  индивидуальных счётчиков доверия, распространяя дальше этот призыв.

Для информирования общества о своей инициативе такой человек  публикует повторно исходный текст, изменяя лишь дату и обозначение лица, которому он хочет посвятить от своего имени всё, чего мы сможем добиться сообща  к указанному времени. Например,  если показанный к 09.02.09г. результат будет стоить того, то пусть особо за нас порадуются все Галины, которые в этот день родились. Кто не считает нужным делать такие   посвящения, тот исключает этот абзац из своего текста.

Пока не найден лучший способ оценки количества людей, включивших индивидуальные счётчики оставшегося доверия, все желающие быть учтёнными в этом качестве отмечаются в блоге сообщества «Но есть  одно НО», с которого начинается, как с чистого листа,  совершенно новая, ироническая и сугубо позитивная история слова «жид». http://www.thebobs.com/index.php?w=1222797567113421HVEBTHZD

Чтобы отметиться в порядке саморегистрации, можно просто отдать свой голос по варианту опроса, опубликованного на первой странице блога. Но можно оставить ещё и комментарий по факту включения индивидуального счётчика. Здесь же опубликован текст молитвы двух маленьких курдов, которая непосредственно предшествовала возникновению идеи включить счётчик.  

При повторном опубликовании текста желающие могут добавлять свои имена и прочие реквизиты, пока список невелик, учёт не продуман и сама идея не опробована.  А потом  появятся обратные связи, которые и приведут весь порядок продвижения идеи в надлежащий вид.

Михаил С.  /МАРНИЧ/

02.02.09г.  г. Минск
 


-----
Каким ты видишь кризис морали, спросил у сильного слабый? Это когда взаимопонимание как у скота с забойщиком скота: они не могут спросить за что, а он не знает ответить что. А ты каким его видишь?

Всего сообщений: 15 | Присоединился: сентябрь 2007 | Отправлено: 5 фев. 2009 3:55 | IP
kes2006


Новичок

помогите пожалуйста составили програмку в VBA, но почему то она не считает y при предельном значении x. условие расчитать y при x от -3 до 1,8 с шагом 0,6. вот что мы сотворилиPublic Sub zadacha1()
Dim a, b, x0, xk, dx, x, y As Single
Cells(1, 1).Value = "a"
Cells(1, 2).Value = "b"
Cells(1, 3).Value = "x0"
Cells(1, 4).Value = "xk"
Cells(1, 5).Value = "dx"
a = Cells(2, 1).Value
b = Cells(2, 2).Value
x0 = Cells(2, 3).Value
xk = Cells(2, 4).Value
dx = Cells(2, 5).Value
x = x0
i = 4
10 If x > 0 Then
y = Sqr(b ^ 3) / x + Sin(a * x / 9)
Else
y = Sqr(b ^ 3) / x + Sin(a * x / 9)
End If
Cells(4, 1).Value = "x"
Cells(4, 2).Value = "y"
Cells(i + 1, 1).Value = x
Cells(i + 1, 2).Value = y
If x <> 0 Then
End If
Cells(10, 2).Value = "otvet net"
i = i + 1
x = x + dx
If x <= xk Then GoTo 10
End Sub

Всего сообщений: 14 | Присоединился: февраль 2009 | Отправлено: 7 марта 2009 19:14 | IP

Отправка ответа:
Имя пользователя   Вы зарегистрировались?
Пароль   Забыли пароль?
Сообщение

Использование HTML запрещено

Использование IkonCode разрешено

Смайлики разрешены

Опции отправки

Добавить подпись?
Получать ответы по e-mail?
Разрешить смайлики в этом сообщении?
Просмотреть сообщение перед отправкой? Да   Нет
 

Переход к теме
<< Назад Вперед >>
Одна страница

Форум работает на скрипте © Ikonboard.com