Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 69044 Skopiuj do schowka Jak to się robi
Autor Wiadomość
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 04-10-2020, 18:49   Jak to się robi

Nie wiem, czy ktoś już zna tę zagadkę, ale podaję.

Sprawa jest prosta: prawy klik na każdej z komórek A1:B2 -> Format Cells -> zakładka Fill -> wybrać odpowiedni kolor.

Pytanie: jak wypełnić te 4 komórki kolorami ale bez wykonania powyższych czynności, bez użycia żadnej pozycji menu Ribbon, bez użycia kodu VBA, bez użycia żadnej zewnętrznej aplikacji - dozwolony jest tylko Notatnik. Kolory mogą być dowolne.

kolory.jpg
Plik ściągnięto 23 raz(y) 12.23 KB

ID posta: 393066 Skopiuj do schowka
 
 
Rafał B.
Stały bywalec Excelforum



Wersja: Win Office 2016
Pomógł: 36 razy
Posty: 253
Wysłany: 05-10-2020, 09:11   

Rozumiem, że wypakowanie pliku nie wchodzi w grę jako zewnętrzna aplikacja? Wówczas zagadka dotyczyłaby oczywiście tylko plików niebinarnych .xlsx, .xslm i polegała zapewne na jakichś modyfikacjach jednego z plików .xlm.

Drugie rozwiązanie spełniające opisane kryteria, to napisanie krótkiego kodu VBS.
_________________
Jest niemal niemożliwe nauczenie dobrego programowania uczniów, którzy byli narażeni na kontakt z BASIC: jako potencjalni programiści są okaleczeni, bez nadziei na poprawę. (Edsger Dijkstra, pionier informatyki).
Po części dotyczy również VBA.
ID posta: 393083 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 05-10-2020, 10:50   

Rafał B. napisał/a:
Rozumiem, że wypakowanie pliku nie wchodzi w grę jako zewnętrzna aplikacja? Wówczas zagadka dotyczyłaby oczywiście tylko plików niebinarnych .xlsx, .xslm i polegała zapewne na jakichś modyfikacjach jednego z plików .xlm.

Drugie rozwiązanie spełniające opisane kryteria, to napisanie krótkiego kodu VBS.

Dziękuję za odpowiedź.
Jeśli chodzi o użycie WinRAR, 7-zip to nie jest dozwolone. Tylko Notatnik jest dozwolony.
Co do VBS, niech będzie. Pierwszy etap akceptuje VBS.

A teraz drugi etap: wszelkie kody np. VBA, VBS, BAT, i co tam jeszcze, nie są dozwolone.

Oczywiście znam odpowiedź, ale bardzo jestem ciekaw, czy są inne sposoby.
-----------
Co do VBS i "modyfikacje jednego z plików .xlm" to naprawdę nie wyobrażam sobie, jak to ma wyglądać. Ale to moja wina, że nie napisałem jasno. Tak naprawdę chodzi mi o to: uruchomimy Excel -> Excel tworzy nowy czysty skoroszyt -> teraz mamy wykonać pewne czynności, aby komórki A1:B2 miały kolory. Nie ma żadnego wcześniej zapisanego pliku, więc nie ma niczego dla WinRAR, 7-zip i VBS.
ID posta: 393092 Skopiuj do schowka
 
 
Rafał B.
Stały bywalec Excelforum



Wersja: Win Office 2016
Pomógł: 36 razy
Posty: 253
Wysłany: 05-10-2020, 12:15   

apollo napisał/a:
Co do VBS i "modyfikacje jednego z plików .xlm" to naprawdę nie wyobrażam sobie, jak to ma wyglądać. Nie ma żadnego wcześniej zapisanego pliku, więc nie ma niczego dla (...) i VBS.

Oczywiście chodził o o plik xml, literówka. Po rozpakowaniu mamy tam prosty dostęp do wszelkich arkuszy, notatnik łyknie bez problemu i na pewno gdzieś można tam zmodyfikować Interior. Ale nie spełnia kryterium nowego, niezapisanego skoroszytu, więc odpada.
A co do skryptu, to plik nie jest potrzebny. Wystarczy przecież przejęcie otwartej instancji i skoroszytu Excela. Ale skoro ma być inne rozwiązanie, to myślimy dalej. Może jakiś HTML z tabelką, użycie jakiejś formuły ładującej, kto wie... :-)
_________________
Jest niemal niemożliwe nauczenie dobrego programowania uczniów, którzy byli narażeni na kontakt z BASIC: jako potencjalni programiści są okaleczeni, bez nadziei na poprawę. (Edsger Dijkstra, pionier informatyki).
Po części dotyczy również VBA.
ID posta: 393094 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 05-10-2020, 13:25   

Rafał B. napisał/a:
apollo napisał/a:
Co do VBS i "modyfikacje jednego z plików .xlm" to naprawdę nie wyobrażam sobie, jak to ma wyglądać. Nie ma żadnego wcześniej zapisanego pliku, więc nie ma niczego dla (...) i VBS.

Oczywiście chodził o o plik xml, literówka. Po rozpakowaniu mamy tam prosty dostęp do wszelkich arkuszy, notatnik łyknie bez problemu i na pewno gdzieś można tam zmodyfikować Interior. Ale nie spełnia kryterium nowego, niezapisanego skoroszytu, więc odpada.

Nawet nie chodzi o niezapisany plik. Masz np. XLSX. Jak go otworzysz? Ja używam WinRAR, 7-zip i nie trzeba rozpakować. Wystarczy otworzyć (nie rozpakować) xlsx (prawy klik -> Otwórz z -> wybrać WinRAR) -> przeciągnąć np. Sheet1.xml na zewnątrz -> modyfikować w Notatniku -> przeciągnąć z powrotem i wybrać nadpisanie -> zamknąć okno WinRAR.

Odpada bo użycie innych aplikacji oprócz Notatnika nie jest dozwolone.
Cytat:
Może jakiś HTML z tabelką, użycie jakiejś formuły ładującej, kto wie... :-)

Przyznaję, że jesteś bardzo pomysłowy
ID posta: 393099 Skopiuj do schowka
 
 
Rafał B.
Stały bywalec Excelforum



Wersja: Win Office 2016
Pomógł: 36 razy
Posty: 253
Wysłany: 05-10-2020, 13:58   

A dziękuję :-D Ale w tym momencie się poddaję, być może da się spreparować COŚ (może wspomniany html z określeniem excelowskiej schemy, o ile taka istnieje), co po skopiowaniu z notatnika da się wkleić przez prawoklik: wklej specjalnie -> jako, ale co tam w notatniku wpisać nie mam pojęcia, a nie chcę guglać (o ile to w ogóle właściwy trop i menu kontekstowe dopuszczalne w zagadce). Życzę powodzenia innym, na pewno ktoś rozgryzie!
_________________
Jest niemal niemożliwe nauczenie dobrego programowania uczniów, którzy byli narażeni na kontakt z BASIC: jako potencjalni programiści są okaleczeni, bez nadziei na poprawę. (Edsger Dijkstra, pionier informatyki).
Po części dotyczy również VBA.
ID posta: 393102 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 05-10-2020, 14:06   

Rafał B. napisał/a:
A dziękuję :-D Ale w tym momencie się poddaję, być może da się spreparować COŚ (może wspomniany html z określeniem excelowskiej schemy, o ile taka istnieje), co po skopiowaniu z notatnika da się wkleić przez prawoklik: wklej specjalnie -> jako,

Tak, idziesz w dobrym kierunku.
ID posta: 393103 Skopiuj do schowka
 
 
Rafał B.
Stały bywalec Excelforum



Wersja: Win Office 2016
Pomógł: 36 razy
Posty: 253
Wysłany: 07-10-2020, 12:04   

Skoro nikt się nie kwapi z rozwiązaniem, to spróbowałem pociągnąć temat dalej.
1. Pokolorowałem komórki
2. Zapisałem plik jako stronę sieci WEB (zaznaczyłem publikację tylko A1:B2)
3. Otworzyłem stronę w notatniku, skopiowałem tekst
4. PPM na A1 w nowym arkuszu -> wklej specjalnie -> i Tekst Unicode* i sukces, pokolorowało komórki.

Następnie z ciekawości okrajałem ten plik aż nawet wywaliłem schemę z nagłówka:
Kod:
<table>
 <tr>
  <td style='background:#009900'>&nbsp;</td>
  <td style='background:#ff3300'>&nbsp;</td>
 </tr>
 <tr>
  <td style='background:#3399ff'>&nbsp;</td>
  <td style='background:#cccc00'>&nbsp;</td>
 </tr>
</table>

i... działa! Office 2016. Więc nawet notatnik nie jest potrzebny, można wpisać sobie w pasku formuły prosty kod tabeli HTML i go przekopiować bez problemu. Fajna ciekawostka, bo może nawet znajdzie kiedyś jakieś zastosowanie 8-) Pozdrawiam!

* nie wiem czemu raz się pojawia na liście wklejania HTML, a raz nie, ale i tak działa tylko jak używam Unicode
_________________
Jest niemal niemożliwe nauczenie dobrego programowania uczniów, którzy byli narażeni na kontakt z BASIC: jako potencjalni programiści są okaleczeni, bez nadziei na poprawę. (Edsger Dijkstra, pionier informatyki).
Po części dotyczy również VBA.
ID posta: 393223 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 07-10-2020, 14:33   

Rafał B. napisał/a:
Skoro nikt się nie kwapi z rozwiązaniem, to spróbowałem pociągnąć temat dalej.

Napisałem, że jesteś pomysłowy, i że idziesz w dobrym kierunku. A teraz brawa na stojąco ;-)

Ja chciałem napisać, że: otworzę Excel z pustym skoroszytem -> wybieram A1 -> otworzę Notatnik -> wprowadzę tekst <table> -> ENTER -> tekst <tr><td bgcolor='EDF6FD'></td><td bgcolor='FF0000'></td></tr> -> ENTER -> tekst <tr><td bgcolor='00FF00'></td><td bgcolor='0000FF'></td></tr> -> ENTER -> tekst </table>

Całość to tak
<table>
<tr><td bgcolor='EDF6FD'></td><td bgcolor='FF0000'></td></tr>
<tr><td bgcolor='00FF00'></td><td bgcolor='0000FF'></td></tr>
</table>

-> zaznaczam całość -> Ctrl + C -> przejdę do Excel -> Ctrl + V

Sprawdziłem z Excel 2010 i 2013
Cytat:
Fajna ciekawostka, bo może nawet znajdzie kiedyś jakieś zastosowanie 8-)

Nie wiem, czy będzie zastosowanie. Na razie zabawa: otworzyć ABC.xlsx -> kliknij w pobliżu A1 -> klawiszami Left i Up dojść do A1 -> otworzyć hehe.txt -> zaznaczyć wszystko -> Ctrl + C -> przejść do Excel -> Ctrl + V.

Cytat:

* nie wiem czemu raz się pojawia na liście wklejania HTML, a raz nie,

Nie wiem, bo używam tylko Ctrl + V

Pozdrawiam

ABC.xlsx
Pobierz Plik ściągnięto 21 raz(y) 461 KB

hehe.rar
Pobierz Plik ściągnięto 20 raz(y) 17.76 KB

ID posta: 393232 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2496 razy
Posty: 8293
Wysłany: 07-10-2020, 21:00   

Super. Fajna ciekawostka. :beer


:clap :clap :clap Rafał B.,
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 393252 Skopiuj do schowka
 
 
Rafał B.
Stały bywalec Excelforum



Wersja: Win Office 2016
Pomógł: 36 razy
Posty: 253
Wysłany: 08-10-2020, 06:03   

@apollo Bardzo ładny zrzut ekranu w Excelu! :danke Jakbyś mógł jeszcze w paru słowach powiedzieć jak go przygotowałeś, jeśli to nie tajemnica (chdzi mi o proces zamiany każdego piksela na sformatowaną komórkę tabeli), czy sam to pisałeś, czy jakieś gotowe automaty są.
_________________
Jest niemal niemożliwe nauczenie dobrego programowania uczniów, którzy byli narażeni na kontakt z BASIC: jako potencjalni programiści są okaleczeni, bez nadziei na poprawę. (Edsger Dijkstra, pionier informatyki).
Po części dotyczy również VBA.
ID posta: 393266 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 08-10-2020, 07:39   

@Rafał B.,

Jak widzisz, trzeba w kodzie VBA tworzyć string postaci:
<table>
<tr><td bgcolor='EDF6FD'></td><td bgcolor='FF0000'></td></tr>
<tr><td bgcolor='00FF00'></td><td bgcolor='0000FF'></td></tr>
</table>

Czyli trzeba znać kolor każdego piksla. Kolor piksla odczytam funkcją API GetPixel. Trzeba w 2 pętlach odczytać kolor i łączyć stringi. Zazwyczaj mały obraz ma dużo piksli, np. 500 x 200 ma 100 000 piksli, więc łączenie tekstów trzeba realizować w inny sposób. Inaczej proces trwa wiekami.

GetPixel zwraca Long, więc żeby otrzymać string np. "EDF6FD" używam Hex$. Ale Hex$ dla niektórych wartości zwraca < 6 znaków (np. dla niebieskiego zwraca "FF"), więc jeśli trzeba to dodać na początku kilka zer "0...0" (w przypadku niebieskiego to dodać "0000")

Na razie nie mam czasu, postaram się później podać kod dla zainteresowanych.
ID posta: 393271 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1306 razy
Posty: 4517
Wysłany: 08-10-2020, 19:37   

Podaję obiecany kod.
Kod:

Option Explicit

Private Const IMAGE_BITMAP As Long = 0
Private Const LR_CREATEDIBSECTION As Long = &H2000
Private Const LR_LOADFROMFILE As Long = &H10

#If VBA7 Then
    Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
    Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As LongPtr
    End Type
#Else
    Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
    End Type
    Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
    Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
    Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
    Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
    Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
#End If

Sub concat_text(text As String, curr_pos, ByVal fragment As String, ByVal delim As String)
    If Len(text) < curr_pos + Len(fragment) + Len(delim) Then text = text & String(10 ^ 6, Chr(0))
    Mid(text, curr_pos, Len(fragment)) = fragment
    curr_pos = curr_pos + Len(fragment)
    Mid(text, curr_pos, Len(delim)) = delim
    curr_pos = curr_pos + Len(delim)
End Sub

Sub DoColorTable(ByVal picFullName As String)
'    picFullName: ścieżka do pliku BMP
#If VBA7 Then
    Dim DC As LongPtr, hbmp As LongPtr, oldBitmap As LongPtr
#Else
    Dim DC As Long, hbmp As Long, oldBitmap As Long
#End If
Dim h As Long, w As Long, curr_pos As Long, width As Long, height As Long, kolor As Long, r As Byte, g As Byte, b As Byte
Dim fso As Object, bmp As BITMAP, text As String, colorStr As String, tmp As String
'    load bitmap
    hbmp = LoadImage(0, picFullName, IMAGE_BITMAP, 0, 0, _
                   LR_CREATEDIBSECTION Or LR_LOADFROMFILE)
'    tworzyć memory device context zgodnego z current screen
    DC = CreateCompatibleDC(0)
'    wybrać bitmap do device context
    oldBitmap = SelectObject(DC, hbmp)
'    odczytać informacje obiektu bitmap
    GetObject hbmp, Len(bmp), bmp
'    długość obrazu
    width = bmp.bmWidth
'    wysokość obrazu
    height = bmp.bmHeight
    colorStr = String(6, "0")
    curr_pos = 1
    concat_text text, curr_pos, "<body><table>" & vbCrLf, ""
'    odczytać kolor piksla
    For h = 1 To bmp.bmHeight
        concat_text text, curr_pos, "<tr>", ""
        For w = 1 To bmp.bmWidth
            kolor = GetPixel(DC, w - 1, h - 1)
            b = kolor \ 256 ^ 2
            g = (kolor - b * 256 ^ 2) \ 256
            r = kolor And &HFF
            Mid(colorStr, 1, 2) = Application.Dec2Hex(r, 2)
            Mid(colorStr, 3, 2) = Application.Dec2Hex(g, 2)
            Mid(colorStr, 5, 2) = Application.Dec2Hex(b, 2)
            tmp = "<td bgcolor='" & colorStr & "'></td>"
            concat_text text, curr_pos, tmp, ""
        Next w
        concat_text text, curr_pos, "</tr>" & vbCrLf, ""
    Next h
    concat_text text, curr_pos, "</table></body>" & vbCrLf, ""
   
    text = Mid(text, 1, curr_pos - 1)
   
    SelectObject DC, oldBitmap
    DeleteDC DC
    DeleteObject hbmp
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile(picFullName & ".txt").Write (text)
    Set fso = Nothing
End Sub

Sub test()
    DoColorTable ThisWorkbook.Path & "\dziewczyna.bmp"
    MsgBox "Zrobione"
End Sub
ID posta: 393322 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe